perm filename DSKSER.16S[J17,SYS] blob sn#105632 filedate 1974-06-11 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00038 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00004 00002	BEGIN DSKSER ↔ 	SUBTTL	DSKSER	DISK SERVICE ROUTINE
C00006 00003	IOS BITS,  DISPATCH TABLE
C00008 00004	DISKUP	DHUNG	BLAST DISK.  DISK HUNG ROUTINE
C00010 00005	SETDDB CLRDDB	CORE ALLOCATION ROUTINES
C00013 00006	REFRES		DISK REFRESHER (I. E., INITIALIZER)
C00017 00007	TIME CONTROL. INFORMATION KEPT AS FOLLOWS:
C00025 00008	 BUFFERED I/O
C00034 00009	 DUMP MODE I/O
C00038 00010	DUMP MODE INPUT
C00043 00011	DUMP MODE OUTPUT
C00047 00012	BOTH INPUT & OUTPUT CLOSE ARE ALWAYS CALLED FROM UUOCON.
C00052 00013	RELEASE UUO, CALL RESET, AND CALL EXIT
C00056 00014	MTAPE UUO -- BY R. HELLIWELL -- 16 JAN 72
C00061 00015		GDWRIT, GDREAD
C00065 00016		SETSAT, CLRSAT
C00067 00017		SATWRT, SATRD, SATFRC
C00070 00018		FILINF, WRTINF
C00075 00019		WRTOFF, RDOFF
C00078 00020		DIAGL, DIAGW
C00081 00021		GETRTR
C00084 00022		INFCOM, ADDBLK, FILEUP
C00088 00023	LOOKUP
C00095 00024	ENTER
C00103 00025	RENAME
C00114 00026	FILE ACCESS CONTROL.
C00120 00027	SEARCH MFD AND UFD FOR FILE.
C00130 00028	 RETRIEVAL SUBRS
C00139 00029	 SAT TABLE OPERATIONS
C00142 00030	ASNSAT
C00145 00031	DELETE A FILE, FREE DISK BLOCKS
C00147 00032	 SWAPPER INTERFACE
C00151 00033	ENTER HERE FOR HIGH PRIORITY TRANSFER (CURRENTLY ONLY UDP IO).
C00155 00034	I-LEVEL SUBRS RETURN HERE WHEN DONE TO START ANOTHER REQUEST.
C00158 00035	I-LEVEL SUBRS PUSHJ HERE TO START A TRANSFER.
C00159 00036		SUBTTL ERROR HANDLING
C00163 00037	 USER DISK PACK SERVICE
C00167 00038	UDP PASS WORD STUFF
C00170 ENDMK
C⊗;
BEGIN DSKSER ↔ 	SUBTTL	DSKSER	DISK SERVICE ROUTINE
↑DEVBEG←←.			;START OF THE DEV SERVICES IN ENTIRE SYSTEM

	DEFINE	IOPCON <DIPCON>

; PRELIMINARIES, STORAGE CONTROL

;THIS CODE DEPENDS HEAVILY UPON:
; 1) NO RESCHEDULING AT UUO LEVEL
; 2) JOB NOT SHUFFLED OR SWAPPED WHEN IO ACTIVE.

TRIES←←1			;ASK DSKINT TO TRY A TRANSFER THIS MANY TIMES
ERRBOX←←1			;PLACE FOR ENTER, LOOKUP ERROR CODES
BUFIOW: XWD -BLKWDS,SYSBUF	;167 FORMAT
UFDEXT←←'UFD'			;SIXBIT UFD.

↑MFDENT:	'  1  1'	;'DIRECTORY ENTRY' FOR MFD
MFDEXT:		'UFD   '
MFDPRO:		155740,,0	;ANYONE CAN READ THE MFD
MFDLOC:		1		;DISK LOC. OF MFD
↑BAND0:		0
↑SATLOC:	0

UNAM←←0
UEXT←←1
UPRO←←2
UPPN←←3

DWRITE←←100			;TELL 167 TO WRITE, ELSE READ.
IOPDCH←←IOPCHN			;HI PRIORITY CHANNEL FOR 167
MSGPPN:	'  2  2'		;PPN OF MESSAGE AREA
;IOS BITS,  DISPATCH TABLE

;BITS IN LH IOS INDICATE FILE STATUS:

↑GOBIT←←400000
↑READB←←200000
↑WRITEB←←100000
↑ALTERB←←40000
RENAMB←←20000
DELETB←←10000
NTRUFD←←4000
PNTDIF←←2000
IOSET←←400		;CHEAT FOR USETI IN CLOSE
LOSBIG←←200
SATOP←←100
HDRDIF←←4		;HOPEFULLY WE CAN GET AWAY WITH THIS ONE, (SAME BIT AS IOFST!)
↑DSKFGS←←SATOP+GOBIT

;USER STATUS BITS IN RH IOS:

DMPBIT←←400
GARBIT←←200

;IDENTIFY DDB LOCATIONS FOR TVSER. LOCATIONS ARE SAME 
;AS IN BLACKINGTON, FOR NO GOOD REASON.

↑DSKBUF←←17
↑DSKCNT←←20

	JRST	CLRDDB		;GIVE BACK DDB
	JRST	SETDDB		;MAKE DDB
	JRST	DSKINI		;INITIALIZATION (SYSINI)
	JRST	DHUNG		;SHOULDN'T HANG
↑DSKDSP:JRST	DRELES		;RELEASE
	JRST	DCLOSO		;CLOSE OUTPUT
	JRST	DBUFO		;BUFFERED OUTPUT
	JRST	DBUFI		;BUFFERED INPUT
	JRST	DENTER		;ENTER
	JRST	DLOOK		;LOOKUP
	JRST	DDMPO		;DUMP OUTPUT
	JRST	DDMPI		;DUMP INPUT
	JRST	DSETO		;USETO
	JRST	DSETI		;USETI
	JRST	DGETF		;UGETF
	JRST	DRENAM		;RENAME
	JRST	DCLOSI		;CLOSE INPUT
	POPJ	P,		;UTPCLR
	JRST	DGETW		;MTAPE
;DISKUP	DHUNG	BLAST DISK.  DISK HUNG ROUTINE

DISKUP:	CONO	IBM,CLRCHL
	MOVEI	TAC1,2				;MAY TAKE THIS MANY IF SCREWED UP.
DSKUP2:	CONO	IBM,1				;.....
	CONO	IBM,2				;NOW RESET IBM.
	MOVEI	TAC,10000			;...WHICH MAY TAKE A WHILE.
	SOJG	TAC,.
	SOJGE	TAC1,DSKUP2
	CONO	PMP,460010!DSKCHN		;ENABLE FOR RANDOM INT'S
	POPJ	P,

;CALLED FROM DEVCHK BY SPECIAL CALL, DDB NOT SETUP
DHUNG:	PUSHJ	P,DISKUP		;FLUSH THE WORLD.
	CONO	PMP,10			;MAKE SURE CHANNEL DOESN'T INTERRUPT ANYONE
	DATAO	IBM,NOPCMD		;NOW SEE IF HE IS LISTENING TO US
	MOVEI	TAC,100000		;WAIT THIS LONG
	CONSO	PMP,460000		;WAIT FOR NEW STATUS, UNEND, OR PARITY ERROR.
	SOJG	TAC,.-1			;WAIT FOR SOME STATUS
	CONI	PMP,TAC			;GET GOOD BITS
	TRC	TAC,600			;CHANNEL END, DEVICE END
	TRCN	TAC,600			;DID WE GET THEM BOTH?
	JRST	OKNOW			;YES.  PERHAPS THE DISK IS HAPPY NOW
	PUSHACS
	PUSHJ	P,DISDATE
	PUSHJ	P,DISMES	
	ASCIZ	/RESET DISK.  THEN PUSH CONTINUE.
/
	SETOM	DISFLAG
	PUSHJ	P,DISFLUSH		;MAKE SURE THEY SEE IT 
	POPACS
	HALT	.+1
	PUSHJ	P,DISKUP		;BLAST HIM AGAIN
OKNOW:	CONO	PI,PIOFF		;MAKE SURE WE DON'T LOSE
	SETOM	HNGFLG			;TELL DSKINT WHY
	CONO	PMP,660010!DSKCHN	;MAKE AN INTERRUPT ON DISK CHANNEL
	CONO	PI,PION
	POPJ	P,
;SETDDB CLRDDB	CORE ALLOCATION ROUTINES


↑SETDDB:			;CALLED BY ASSASG IN IOCSS FOR INIT UUO.
	PUSHJ	P,GCOR1
	HRRI	DDB,DDBSKW(TAC)			;SAVE GOOD BITS IN LH
	HRLI	TAC,DSKDDB-DDBSKW		;SOURCE ADDRESS IN LH
	BLT	TAC,DMPBUF(DDB)			;CLEAR, INITIALIZE DDB
	HRLM	DDB,DEVSER+DSKDDB		;NEW LINK IN DUMMY
	SETZM	DEVLOG(DDB)			;CLEAR LOGICAL NAME.
	PUSHJ	P,DCLSDD
	DPB	J,[POINT 6,DEVOAD(DDB),5]	;SET JOB NUMBER
	POPJ	P,


↑CLRDDB:			;CALLED BY RELEASE IN UUOCON FOR RELEASE UUO.
	PUSHJ	P,DCLSDD
	SETZB	IOS,DEVIOS(DDB)			;HEAR NO EVIL
	MOVEI	TAC,DSKDDB			;SEARCH FOR THIS DDB
CLRDD1:	MOVEI	TAC1,(TAC)
	HLRZ	TAC,DEVSER(TAC1)
	JUMPE	TAC,CPOPJ			;SHOULDN'T HAPPEN
	CAIE	TAC,(DDB)			;RIGHT ONE YET?
	JRST	CLRDD1				;NO. KEEP SEARCHING
	MOVE	DDB,DEVSER(TAC)			;LINK TO ONE AFTER LOSER
	HLLM	DDB,DEVSER(TAC1)		;SPLICE AROUND IT
	SUBI	TAC,DDBSKW			;CALC ADDRESS OF FREE STG BLOCK
	JRST	RCOR1				;RETURN TO DISK FREE STG. AND POPJ


;CORE ALLOCATION ROUTINES

GETCOR:	PUSHJ	P,GCOR1				;GET DUMP MODE COMMAND BUFFER.
	MOVSM	TAC,DMPBUF(DDB)
	POPJ	P,

GCOR1:	MOVEI	AC3,DDBSIZ			;SET SIZE
	PUSHJ	P,FSGET				;GET FREE STORAGE
	JRST	GCOR2				;HAVE TO WAIT
	MOVEI	TAC,(AC1)			;RETURN ADDRESS IN TAC
	POPJ	P,

GCOR2:	SUB	P,[XWD 4,4]			;CALLED FROM COMMAND DECODER
	JRST	DLYCM1

RTNCOR:	HLRZ	TAC,DMPBUF(DDB)			;RELEASE DUMP MODE CMD BUFFER.
	SETZM	DMPBUF(DDB)
	JUMPE	TAC,CPOPJ			;IF NONE, LEAVE QUICK
RCOR1:	HRRZ	AC1,TAC				;GET ADDRESS OF BLOCK
	JRST	FSGIVE				;RETURN IT
;REFRES		DISK REFRESHER (I. E., INITIALIZER)

↑REFRES:PUSHJ	P,DQINI			;INITIALIZE SUBR QUEUE, ETC.
	CONO	PI,PION
	MOVEI	DDB,DSKDDB
	MOVEI	IOS,0
	MOVEI	DAT,SATIN		;READ IN OLD SAT TABLE.
	PUSHJ	P,DDOIT			;SEE TO IT.
	SKIPE	TAC,BADCNT		;SEE IF ITS BAD TRACK TABLE IS BELIEVABLE.
	CAIL	TAC,BADMAX
	JRST	REF3			;IGNORE OLD TABLE.
	MOVEI	TAC1,0			;CHECKSUM OLD TABLE.
	ADD	TAC1,BADTRK-1(TAC)
	SOJG	TAC,.-1
	CAMN	TAC1,BADCHK
	JRST	REF4			;IT CHECKS. USE IT.
REF3:	SETZM	BADCNT			;FLUSH OLD TABLE.
	SETZM	BADCHK
REF4:	MOVE	TAC1,TIME		;GET CURRENT TIME,
	DATAI	444,TAC			;AND CURRENT POSITION OF LIBRASCOPE..
	XOR	TAC,TAC1		;..AND MAKE SHINY NEW SATID.
	MOVMM	TAC,SATID		;MAKE SATID ALWAYS POSITIVE.
	MOVMM	TAC,SATID1		;MAKE BACKUP SATID'S RIGHT
	MOVMM	TAC,SATID2
	SETZM	LSTBLK
	SETZM	SATBIT
	MOVE	TAC,[SATBIT,,SATBIT+1]
	BLT	TAC,SATBIT+SATWCT	;CLEAR THE REST
	MOVE	TAC,MFDLOC		;PROTECT MFD IN SAT
	SUBI	TAC,1
	IDIVI	TAC,=36			;DO THE MAPPING OURSELVES
	MOVEI	DAT,1			;TO ACHIEVE UNCONDITIONLITY
	MOVEM	DAT,DSKUSE		;ECONOMY!
	ROT	DAT,(TAC1)
	IORM	DAT,SATBIT(TAC)
	MOVEM	DAT,SATCHK		;OK FOR SAT TABLE.
	MOVEI	DAT,SATOUT		;WRITE IT.
	PUSHJ	P,QENTER
	PUSHACS
	PUSHJ	P,DISINIT		;HERE FROM ONCE, WE NEED TO INITIALIZE THIS
	PUSHJ	P,DISDATE
	PUSHJ	P,DISMES
	ASCIZ	/SATID=/
	MOVE	TAC,SATID
	PUSHJ	P,DISOCT
	PUSHJ	P,DISMES
	ASCIZ	/  BADCNT=/
	MOVE	TAC,BADCNT
	PUSHJ	P,DISLOC
	PUSHJ	P,DISCRLF
	SETOM	DISFLAG
	PUSHJ	P,DISFLUSH		;FORCE ALL MESSAGES OUT
	POPACS
REF2:	MOVEI	TEM,SYSRTV		;CONSTRUCT EMPTY MFD IN SYSBUF
	HRLI	TAC,MFDENT
	HRRI	TAC,DSKDAT(TEM)
	BLT	TAC,DDPRO(TEM)		;COPY NAME, EXT, PROT
	MOVE	TAC,SYSPPN
	MOVEM	TAC,DDPPN(TEM)
	SETZM	DDLNG(TEM)
	HRLI	TAC,DDLNG(TEM)
	HRRI	TAC,DDLNG+1(TEM)
	BLT	TAC,BKDSIZ+SECSIZ-1+DSKDAT(TEM)		;CLEAR THE REST
	MOVE	TAC,MFDLOC		;SET UP RTVL PTRS
	MOVEM	TAC,DDLOC(TEM)
	HRLM	TAC,DPTR(TEM)
	AOS	DGRP1R(TEM)
	MOVE	TAC,SATID
	MOVEM	TAC,DSATID(TEM)		;GIVE MFD THE SAT ID TOO
	MOVE	TAC,THSDAT		;DATE CREATED
	HRRM	TAC,DDEXT(TEM)
	PUSHJ	P,DSKTM1
	DPB	TAC,[POINT 3,DDEXT(TEM),20];RPH/DATE75
	ORM	TAC1,DDPRO(TEM)		;TIME LAST WRITTEN
	PUSHJ	P,XWSYNC		;WAIT FOR SATOUT
	MOVE	TAC,BUFIOW
	MOVEM	TAC,TFRIOW(DDB)
	MOVE 	TAC,MFDLOC
	PUSHJ	P,BK2SEC
	MOVEM	TAC,TFRSEC(DDB)
	MOVEI	DAT,TSTART

DDOIT:	PUSHJ	P,QENTER		;MAKE REQUEST AND

XWSYNC:	MOVE	TAC,[XWD DEVSBB,IOACT]	; SPIN TILL DONE
	TDNE	TAC,DEVIOS(DDB)
	JRST	.-1
	POPJ	P,
;TIME CONTROL. INFORMATION KEPT AS FOLLOWS:
;DATE CREATED IN UFD (FILEXT) [DEC - DATE LAST WRITTEN]
;TIME LAST WRITTEN IN UFD (FILPRO) [DEC - TIME CREATED]
;TIME LAST REFERENCED IN FILE - DREFTM
;TIME LAST DUMPED IN FILE - DDMPTM
;LATTER TWO ARE ACCESSED THRU 6-WORD ENTER-LOOKUP BLOCKS IF
;DMPBIT SET BY INIT.

↑DSKTM1:			;CALLED ALSO FROM UUOCON -DSKTIM UUO
	MOVE	TAC,TIME
	IDIVI	TAC,=3600			;JIFFIES/MIN.
	HRRZ	TAC1,THSDAT
	DPB	TAC,[POINT 11,TAC1,23]
	LDB	TAC,[POINT 3,THSDAT,35-12]	;EXTRA BITS IN TAC - RPH/DATE75
	POPJ	P,				;RETURN RESULT IN TAC1.

;DSKSTP CALLED FROM AUTORELOAD CODE IN OUTER TO PRESERVE THE SAT TABLE
↑DSKSTP:
	PUSHJ	P,DQINI		; CLEAR QUEUE
	CONO	PI,2202		; TURN ON PI AND CH6
OSAT:	MOVEI	DDB,DSKDDB
	PUSHJ	P,CUSATO
	JRST	XWSYNC

ISAT:	MOVEI	DDB,DSKDDB	;HERE FROM ACISAT
	MOVEI	DAT,SATIN
	PUSHJ	P,NENTER
	JRST	XWSYNC		;WAIT FOR DISK AND RETURN

;DSKINI CALLED VIA DISPATCH FROM IOGO IN SYSINI FOR 200 RESTART.

DSKINI:	PUSHJ	P,DQINI
	SETZM	CUSLOC			;FORGET CUSLOC ON RESTARTS
	PUSHJ	P,ACISAT		;READ SAT TABLE
	MOVE	TAC,DSKDDB+DEVIOS	;GET IOS BITS
	TRNE	TAC,IODERR!IODTER	;DID IT WORK?
	JRST	NOSAT			;NO
	MOVEI	DDB,UDP0DD		;LINK OUT CRUFTY OLD DISK DDB'S
	HRLM	DDB,DSKDDB+DEVSER
	MOVEI	DDB,DSKDDB		;MAKE SURE WE LINK TO UDPINI
	SKIPE	FBACT			;SWAPPING WHERE?
	POPJ	P,			;ON FASTBANDS, SKIP SWAPPING PACK CRUD
PASCHK:	MOVEI	DDB,CAT(CAT(UDP,\<UPACKS-1>),DD)
	MOVEI	TAC,ASSCON!ASSPRG
	IORM	TAC,DEVMOD(DDB)		;ASSIGN THIS UDP
	MOVE	TAC,['*SWAP*']
	MOVEM	TAC,DEVLOG(DDB)		;ANNOUNCE THAT UDP IS USED FOR SWAPPING
	SETZB	TAC,DEVIOS(DDB)
	DPB	TAC,PJOBN		;TO JOB 0
	SETZM	SWPDDB			;THIS IS THE UDP WE ARE SWAPPING ON
	MOVEI	DAT,PASSIN		;READ PASSWORD BLOCK
	PUSHJ	P,NENTER
	PUSHJ	P,XWSYNC		;WAIT FOR IT
	MOVE	TAC,DEVIOS(DDB)
	TRNE	TAC,IODERR!IODTER!IOIMPM
	JRST	PASERR			;IO ERRORS OCCURED
	MOVE	TAC,['PASS  ']		;IS IT INITIALIZED
	CAMN	TAC,DSKDAT(DDB)
	CAME	TAC,DSKDAT+1(DDB)
	JRST	PASOK			;NO. IT MUST BE GRUNGY PACK
	SKIPN	DSKDAT+2(DDB)		;PASSWORD MUST BE NULL FOR SWAPPING
	JRST	PASOK			;OK
	PUSHACS
	PUSHJ	P,DISMES
	ASCIZ	/YOU SEEM TO HAVE THE WRONG SWAPPING PACK!
/
PASTRY:	PUSHJ	P,DISMES
	ASCIZ	/FIX IT.  THEN PUSH CONTINUE TO TRY AGAIN
/
	SETOM	DISFLAG
	PUSHJ	P,DISFLUSH
	POPACS
	HALT	PASCHK			;TRY AGAIN

PASERR:	PUSHACS
	TRNN	TAC,IOIMPM		;OFFLINE OR WRITE-LOCK?
	JRST	PASIOE			;NO.  REAL IO ERROR
	PUSHJ	P,DISMES
	ASCIZ	/SWAPPING PACK OFF LINE!
/
	JRST	PASTRY

PASER1:	PUSHACS
	TRNN	TAC,IOIMPM		;WRITE LOCK?
	JRST	PASIOE			;NO. REAL IO ERROR
	PUSHJ	P,DISMES
	ASCIZ	/SWAPPING PACK WRITE LOCKED!
/
	JRST	PASTRY

PASIOE:	PUSHJ	P,DISMES
	ASCIZ	/IO ERROR ON ACCESSING SWAPPING PACK!
/
	JRST	PASTRY

PASOK:	MOVEI	DAT,PASOUT		;NOW TRY WRITING
	PUSHJ	P,NENTER
	PUSHJ	P,XWSYNC
	MOVE	TAC,DEVIOS(DDB)
	TRNE	TAC,IODERR!IODTER!IOIMPM
	JRST	PASER1			;POSSIBLY WRITE-LOCKED
	MOVEM	DDB,SWPDDB		;SAVE DDB ADDRESS FOR SWAP OPS
	MOVEI	DDB,DSKDDB		;SET UP DDB FOR SYSINI?
	POPJ	P,

NOSAT:	PUSHACS
	MOVE	TAC,[JRST AUTOLOAD]	;MAKE THEM START FROM THE FRONT
	MOVEM	TAC,SYSDSP
	MOVEM	TAC,SYSDSP+2
	MOVE	TAC,[XWD SYSDSP+2,SYSDSP+3]
	BLT	TAC,SYSDSP+7
	MOVE	TAC,UPTIME
	MOVEM	TAC,LASTRESTART		;DON'T DO A 200 RESTART
	PUSHJ	P,DISDATE
	PUSHJ	P,DISMES
	ASCIZ	/FAILED TO GET SAT TABLE READ IN.  CHECK DISK, THEN RELOAD.
/
	SETOM	DISFLAG
	PUSHJ	P,DISFLUSH
	POPACS
	HALT	AUTOLOAD

DQINI:	SETZM	UPTR			;CLEAR UDP QUEUE
	SETZM	QBEGIN			;INITIALIZE DISK SUBR QUEUE.
	MOVSI	TAC,QBEGIN
	HLRZM	TAC,MIPTR
	HLRZM	TAC,MOPTR
	SETZM	DQCNT			;NUMBER OF TASKS IN DISK QUEUE
	HRRI	TAC,QBEGIN+1
	BLT	TAC,LOGEND		;CLEAR OUT REQUEST QUEUE
	PUSHJ	P,DISKUP		;MAKE IBM LISTEN TO US

IJOB:	SETZM	DFBUSY
	SETZM	SQREQ
	HLLZS	IOPCON
	SETZM	DXB
	SETZM	DSKEDD
	SETZM	ERRBIT
	SETZM	DSKERB
	SETZM	BKIN
	POPJ	P,

ACISAT:	CONO	PI,PION			;CERTAINLY ISN'T ON YET
	SKIPN	SATMOD			;READ IF -1.(FIRST TIME ONLY)
	JRST	OSAT			;ELSE WRITE (POPJ FROM OSAT)
	MOVE	TAC,SATID		;MAKE SURE COPIES OF SATID AGREE
	MOVEM	TAC,SATID1
	MOVEM	TAC,SATID2
	PUSHJ	P,ISAT			;GET SAT IN
	MOVE	TAC,SATID		;NOW COPY GOOD SATID
	MOVEM	TAC,SATID1
	MOVEM	TAC,SATID2
	MOVE	TAC,[POINT 1,SATBIT]	;PREPARE TO COUNT SAT BITS!
	MOVEI	TAC1,(LSTBIT+43)/44*44	;NUMBER OF BITS IN TABLE ROUNDED TO WORD BOUNDARY
	SETZ	AC1,			;NUMBER OF BITS ON SO FAR
	ILDB 	AC2,TAC			;LOAD A BIT
	ADDI	AC1,(AC2)		;SEE THE CLEVER PROGRAMMER COUNT BITS
	SOJGE	TAC1,.-2		;COUNT THEM ALL
	MOVEM	AC1,DSKUSE		;SET HONEST DSKUSE
	SETZM	SATMOD			;WRITE SAT TABLE FROM NOW ON.
	SKIPN	AC2,BADCNT		;ANY BAD TRACKS TO TURN ON?
	POPJ	P,
	CAILE	AC2,BADMAX
	MOVEI	AC2,BADMAX
	MOVEI	AC3,0
MRKITB:	MOVE	TAC,BADTRK(AC2)
	PUSHJ	P,MRKBLK		;MARK BAD TRACK SO IT WON'T GET USED
	ADD	AC3,TAC			;ACCUMULATE NEW BADCHK
	SOJG	AC2,MRKITB
	MOVEM	AC3,BADCHK		;STORE NEW CHECKSUM
	POPJ	P,
; BUFFERED I/O

;BUFFERED INPUT

DBUFI:	TLNN	IOS,READB!WRITEB!ALTERB	
	JRST	ENOLUK				;NO LOOKUP
	TRNE	IOS,IODERR!IODTER		;ERROR LAST TIME?
	POPJ	P,				;YES
	TLNE	IOS,LOSBIG			;BAD RETRIEVAL?
	JRST	EGARB				;YES PRINT MESSAGE
	MOVSI	IOS,IO
	ANDCAB	IOS,DEVIOS(DDB)			;MARK AS READING
	JSP	AC1,TSTEOF			;RETURN NOW IF PAST EOF
	JRST	DIEOF
	MOVEI	DAT,DIBUFI
	PUSHJ	P,QENTER			;QUEUE TASK. USER PGM CAN PROCEED
	POPJ	P,

TSTEOF:	MOVE	TAC,USETP(DDB)			;GET USET POINTER
	SUBI	TAC,1
	ASH	TAC,RECWSH			;RECORD NUMBER * 200 = WORD NUMBER
	CAMGE	TAC,FILLNG(DDB)			;PAST EOF?
	JRST	1(AC1)				;NO.  OK TO READ MORE
	JRST	(AC1)				;PAST EOF

;***INTERRUPT SUBR***

DIBUFI:	PUSHJ	P,GETBLK			;GET BLOCK INTO SYSBUF
	JUMPE	TAC,SETLOS			;NON EX = BAD RETRIEVAL
	PUSHJ	P,AUDCHK			;DID WE GET THE RIGHT FILE?

DIBFI1:	MOVE	TAC,USETP(DDB)
	SUB	TAC,DGRP1R(DDB)
	IDIVI	TAC,RCPBLK
	ASH	TAC1,RECWSH			;7
	HRRZ	TAC,DEVIAD(DDB)			;GET REL. ADDR. OF USER BUFFER
	HLRZ	DAT,PROG
	CAIG	TAC,(DAT)			;ILL. ADR.?
	JRST	DIBFI3				;NO, RELOCATE BY PROG
	LDB	DAT,PSEGN			;YES, CHECK FOR UPPER SEGMENT
	HRRZ	DAT,JBTADR(DAT)
	ADDI	TAC,-400000(DAT)
	JRST	DIBFI4

DIBFI3:	ADDI	TAC,(PROG)			;RELOCATE INTO LOWER
DIBFI4:	HRLI	DAT,SYSDTA(TAC1)
	HRRI	DAT,2(TAC)
	BLT	DAT,RECSIZ+1(TAC)		;INTO USER'S BUFF
	AOS	TAC1,USETP(DDB)
	SUBI	TAC1,1
	ASH	TAC1,RECWSH
	SUB	TAC1,FILLNG(DDB)
	MOVEI	DAT,RECSIZ			;SET UP WORD COUNT
	JUMPL	TAC1,DIBFI2			;IF NOT PAST EOF
	TLO	IOS,IOEND			;EOF; TELL USER
	SUB	DAT,TAC1			;ADJUST WORD COUNT
DIBFI2:	HRRM	DAT,1(TAC)			;GIVE WD CT TO USER.
	PUSHJ	P,ADVBFF
	POPJ	P,				;NO MORE BUFFERS EMPTY.
	TLNE	IOS,IOEND			;QUIT IF END OF FILE
	POPJ	P,
	MOVE	TAC,USETP(DDB)
	SUB	TAC,DGRP1R(DDB)
	IDIVI	TAC,RCPBLK
	JUMPN	TAC1,DIBFI1			;DO MORE IF BLK NOT DONE
	POPJ	P,				;QUIT.

DIEOF:	TLO	IOS,IOEND
	JRST	DSIOS				;STORE IOS, AND POPJ.

;BUFFERED OUTPUT

DBUFO:	TLNN	IOS,WRITEB!ALTERB
	JRST	ENOENT
	MOVSI	IOS,IO
	IORB	IOS,DEVIOS(DDB)			;FLAG OUTPUT FOR UUOCON
	TLNE	DDB,OCLOSB			;CALLED BY CLOSE?
	JRST	DBUFO1				;YES, DO OUTPUT NOW
DBUFOA:	TRNE	IOS,IODERR!IODTER		;ERROR RECENTLY
	POPJ	P,				;YES, TELL HIM
	TLNE	IOS,LOSBIG			;OR BAD RETRIEVAL
	JRST	EGARB				;YES
	HLR	TAC,DEVBUF(DDB)			;PTR TO OBUFF HDR
	XCTR	XR,[HRR TAC,(TAC)]		;GET PTR TO NEXT FREE BFR
	XCTR	XR,[SKIPL TAC1,(TAC)]
	JRST	DBFOGO				;NEXT BUFFER IS FREE.
	TRNN	IOS,IOACT			;NEXT BUFFER IS FULL.
	PUSHJ	P,DBUFO1			;IF NOT ACTIVE, START OUTPUT.
	PUSHJ	P,WSYNC				;WAIT FOR OUTPUT TO HAPPEN.
	JRST	DBUFOA				;RETURN OR START NEXT OUTPUT.

DBFOGO:	XCTR	XR,[SKIPGE (TAC1)]		;CHECK ONE AFTER.
	TRNE	IOS,IOACT			;IT'S FULL, OUTPUT ALREADY GOING?
	POPJ	P,				;YES, LET USER RUN.

DBUFO1:	PUSHJ	P,MAKBLK			;ENTER A TRANSFER IN QUEUE.
	MOVEI	DAT,DIBUFO			;CALL INT LEVEL SUBR
	PUSHJ	P,QENTER			;USER PGM CAN PROCEED
	POPJ	P,

;*** INTERRUPT SUBR ***

DIBUFO:	MOVE	TAC,USETP(DDB)			;LOAD SYSBUF & OUTPUT
	MOVEM	TAC,DSKFAD(DDB)
	SUB	TAC,DGRP1R(DDB)
	IDIVI	TAC,RCPBLK
	ASH	TAC1,RECWSH
	MOVEI	TAC,SYSDTA(TAC1)		;DATA AREA OF SYSBUF
	MOVEM	TAC,CORFAD(DDB)
	MOVEM	TAC,CORLAD(DDB)

DIBFO1:	HRRZ	TAC,DEVOAD(DDB)
	HLRZ	TAC1,PROG
	CAIG	TAC,(TAC1)
	JRST	DIBFO2
	LDB	TAC1,PSEGN
	HRRZ	TAC1,JBTADR(TAC1)
	ADDI	TAC,-400000+2(TAC1)
	JRST	DIBFO3

DIBFO2:	ADDI	TAC,2(PROG)
DIBFO3:	SKIPG	AC1,-1(TAC)			;ANY WORDS IN THIS BUFFER
	JRST	DIBFO4				;NO, SKIP OVER IT
	MOVSS	TAC
	HRR	TAC,CORLAD(DDB)
	MOVEI	TAC1,RECSIZ(TAC)
	MOVEM	TAC1,CORLAD(DDB)
	BLT	TAC,-1(TAC1)			;COPY USRBUF TO SYSBUF
	AOS	USETP(DDB)
	PUSHJ	P,ADVBFE
	JRST	DIBOFT				;NO MORE BUFFERS READY
	MOVE	TAC,USETP(DDB)
	SUB	TAC,DGRP1R(DDB)
	IDIVI	TAC,RCPBLK
	JUMPN	TAC1,DIBFO1			;BLOCK NOT DONE, DO MORE

DIBOFT:	MOVE	TAC,CORFAD(DDB)			;PICK UP STARTING ADDRESS
	CAML	TAC,CORLAD(DDB)			;BEFORE FINISHING ADDRESS
	POPJ	P,				;NO, NOTHING TO DO.
	MOVE	TAC,USETP(DDB)			;DID FILE GROW?
	SUBI	TAC,1+1				;-1 FOR AOS ABOVE, -1 FOR LAST RECORD,
	ASH	TAC,RECWSH			;WHICH WILL BE COUNTED BY WC BELOW
	CAILE	AC1,RECSIZ
	MOVEI	AC1,RECSIZ			;AVOID BUMPING WC BY TOO MUCH
	ADDI	TAC,(AC1)			;ADD WC FROM LAST RECORD WRITTEN
	CAMG	TAC,FILLNG(DDB)
	JRST	DIBOFW				;NO, GO DO OUTPUT.
	MOVEM	TAC,FILLNG(DDB)			;YES, MARK IT SO
;	MOVEI TAC,1
;	CAME TAC,DGRP1R(DEVDAT)	;IF BEYOND FIRST GROUP,
;	TLOA IOS,HDRDIF!PNTDIF		;UPDATE RTVL AT CLOSE.
	TLO	IOS,PNTDIF!HDRDIF
DIBOFW:	MOVE	TAC,CORFAD(DDB)			;IF RTVL NOT CONTIGUOUS,
	CAIN	TAC,SYSDTA			;CAN'T WRITE IT NOW.
	TLNN	IOS,PNTDIF
	JRST	DIBOFN				;UPDATING RTVL NOT RQD
	PUSHJ	P,AUDINF
	HRLI	TAC,DSKDAT(DDB)			;BLT RTVL FROM DDB...
	HRRI	TAC,SYSBUF			;TO SYSBUF
	BLT	TAC,SYSDTA-1
;	PUSHJ P,SPREDT		;FIRST UPDATE PRIOR RTVL.
	MOVE	TAC,DSKFAD(DDB)			;SET UP TRANSFER
	PUSHJ	P,LR2BLK
	JUMPE	TAC,SETLOS			;NON EX = BAD RETRIEVAL
	PUSHJ	P,BK2SEC
	MOVEM	TAC,TFRSEC(DDB)
	MOVE	TAC,CORFAD(DDB)
	SUB	TAC,CORLAD(DDB)
	ADD	TAC,[SYSBUF,,-40]
	MOVSM	TAC,TFRIOW(DDB)			;WRITE ONLY THE RETRIEVAL AND VALID DATA
	JRST	RERITE				;GO DO OUTPUT.

DIBOFN:	MOVE	TAC,CORFAD(DDB)			;HERE IF RTVL IS OUT
	SUB	TAC,CORLAD(DDB)			;GET -WORD COUNT
	HRL	TAC,CORFAD(DDB)
	MOVSM	TAC,TFRIOW(DDB)
	MOVE	TAC,DSKFAD(DDB)			;STARTING RECORD NO.
	PUSHJ	P,LR2BLK
	JUMPE	TAC,SETLOS			;NON EX = BAD RETRIEVAL
	PUSHJ	P,BKMAP
	MOVEM	TAC,TFRSEC(DDB)

RERITE:	MOVEI	TAC,DWRITE!IOPCHN
	MOVSM	TAC,TFRCTL(DDB)
	PUSHJ	P,TSTART			;WRITE OUT DATA
	POPJ	P,

SETLOS:	TDO	IOS,[LOSBIG!IOEND,,IODEND]	;SCREW THE BASTARD
	JRST	DSIOS				;STO IOS AND GO UP ONE LEVEL

DIBFO4:	PUSHJ	P,ADVBFE			;ADVANCE THE BUFFERS
	JRST	DIBOFT				;NONE LEFT, DO TRANSFER IF ANY WORDS TO TRANSFER
	JRST	DIBFO1				;LOOK AT ANOTHER BUFFER
; DUMP MODE I/O

;COMMAND LIST IN IOWD FORMAT: (-WDCT)SA-1
;GETS CONVERTED TO 167 FORMAT: (-WDCT)SA
; RETURNS STARTING ADDRESS IN TAC1 AND -WD CT IN TAC

↑DMPCMD:
	MOVEI	AC1,JOBPFI			;LOWER LIMIT
	MOVE	TAC,UUOPC(J)
	TLNN	TAC,USRMOD			;MONITOR OP?
	MOVEI	AC1,JOBSAV			;YES
	HLRZ	AC2,PROG			;UPPER LIMIT=PROTECTION
	LDB	AC3,PSEGN
	JUMPE	AC3,DMPGET			;AC3 ← HIGH SEGEMENT PROTECT ADDR
	HLRZ	AC3,JBTADR(AC3)
	ADDI	AC3,400000			;UPPER SEGMENT ADDRESSES ARE O.K.

DMPGET:
DMPGT1:	XCTR	XR,[SKIPN TAC1,(UUO)]	;GET NEXT COMMAND WORD
	JRST	TPOPJ			;ZERO TERMINATES
DMPGT2:	HLRE	TAC,TAC1		;NEGATIVE WORD COUNT
	ANDI	TAC1,-1			;FIRST ADDRESS-1
	JUMPE	TAC,DMPTCH		;JUMP IF THIS IS A JUMP COMMAND
	ADDI	TAC1,1			;REAL STARTING ADDRESS
	CAIGE	TAC1,(AC1)		;ABOVE MINUMUM PROTECT ADDRESS?
	JSP	DAT,ADRERR		;NO. LOSE.
	PUSH	P,TAC1			;SAVE STARTING ADDRESS
	HRRO	TAC,TAC			;IN CASE HUGE WD CT
	SUB	TAC1,TAC		;CALCULATE LAST ADDR
	CAIG	TAC1,1(AC2)		;IS IT WITHIN LOWER?
	JRST	T1POPJ			;YES.  WIN.
	CAIG	TAC1,1(AC3)		;BENEATH TOP OF UPPER?
	TRNN	TAC1,400000		;YES. IN UPPER AT ALL.
	JSP	DAT,ADRERR		;NO TO ONE OF ABOVE
T1POPJ:	POP	P,TAC1			;GET STARTING ADDRESS BACK
	POPJ	P,			;WIN

DMPTCH:	HRR	UUO,TAC1		;SET ADDRESS OF NEXT COMMAND
	CAIG	TAC1,(AC1)		;ABOVE PROTECTED AREA?
	JSP	DAT,ADRERR		;NO. LOSE
	CAIG	TAC1,(AC2)		;ADDRESS OK?
	JRST	DMPGET			;YES.
	CAIG	TAC1,1(AC3)		;BENEATH TOP OF UPPER?
	TRNN	TAC1,400000		;YES. IN UPPER AT ALL?
	JSP	DAT,ADRERR		;NO TO ONE OF ABOVE
	JRST	DMPGET

DDCALC:	MOVE	AC1,USETP(DDB)		;LOCATE END OF BLOCK
	ADDI	AC1,RCPBLK-1		;CONTAINING USETP
	MOVEI	DAT,RCPBLK
	IDIVM	AC1,DAT			;SEE US CLEVERLY AVOID A REMAINDER !
	IMULI	DAT,RCPBLK
	LSH	DAT,RECWSH		;CONVERT TO WORD COUNT.
	POPJ	P,
;DUMP MODE INPUT

DDMPI:	TLNN	IOS,READB!WRITEB!ALTERB
	JRST	ENOLUK
	JSP	AC1,TSTEOF		;SEE IF IMMEDIATE EOF
	JRST	DDMIEF			;YES. TELL LOSER.
	TLZ	IOS,IO			;FLAG INPUT
	TLO	IOS,GOBIT		;MAKE US UNSTOPPABLE.
	MOVEM	IOS,DEVIOS(DDB)
	PUSHJ	P,DDICOM

DDXIT:	PUSHJ	P,RTNCOR		;RETURN COMMAND BUFFER TO FREE STG
	TRNN	IOS,IODERR!IODTER	;IF DATA OR DEVICE ERROR, LET USER SEE IT!
	TLNN	IOS,LOSBIG		;ELSE IF BAD RETRIEVAL PRINT MESSAGE
	JRST	DPOPJ
	JRST	EGARB

DDICOM:	PUSHJ	P,GETCOR		;GET CORE FOR COMMAND LIST NOW
	PUSHJ	P,GETRET		;GET GROUP DIRECTORY
	JRST	SETLOS			;BAD RETRIEVAL
DDICO2:	PUSHJ	P,DMPCMD		;GET AN IOWD
	MOVEM	TAC1,CORFAD(DDB)	;SAVE STARTING ADDRESS
	MOVE	AC1,USETP(DDB)
	SUBI	AC1,1
	ASH	AC1,RECWSH		;7
	MOVEM	AC1,DSKFAD(DDB)
	SUB	AC1,TAC			;CALC DISK LAST ADDR
	CAMG	AC1,FILLNG(DDB)
	JRST	DDICO3
	TLO	IOS,IOEND
	MOVE	AC1,FILLNG(DDB)		;STOP AT EOF
DDICO3:	MOVEM	AC1,DSKLAD(DDB)

DDIC0:	HLRS	DMPBUF(DDB)
DDIC1:	PUSHJ	P,DDCALC		;FIND BLOCK END.
	CAMLE	DAT,DSKLAD(DDB)		;COMPARE WORD COUNTS.
	MOVE	DAT,DSKLAD(DDB)
	SUB	DAT,DSKFAD(DDB)		;THIS GIVES TFR WORD COUNT.
	MOVN	TAC,DAT
	HRR	TAC1,CORFAD(DDB)
	HLRZ	TEM,PROG
	CAIG	TAC1,(TEM)
	JRST	DDIC2
	LDB	TEM,PSEGN
	HRRZ	TEM,JBTADR(TEM)
	TRZ	TAC1,400000		;FOR 256K IT MUST BE DONE-RPH 4-17-72
	ADDI	TAC1,(TEM)
	JRST	DDIC3

DDIC2:	ADDI	TAC1,(PROG)		;RELOCATE
DDIC3:	HRL	TAC1,TAC		;PUT IN -WD COUNT
	AOS	TEM,DMPBUF(DDB)
	MOVEM	TAC1,-1(TEM)		;ENTER IN COMMAND LIST
	ADDM	DAT,CORFAD(DDB)		;BUMP FIRST ADDR BY WD CT
	ADDB	DAT,DSKFAD(DDB)
	ADDI	DAT,RECSIZ+RECSIZ-1	;ROUND UP TO RECORD
	ASH	DAT,-RECWSH
	MOVE	TAC,USETP(DDB)
	MOVEM	DAT,USETP(DDB)
	PUSHJ	P,LR2BLK
	JUMPE	TAC,SETLOS		;NON EX = BAD RETRIEVAL
	PUSHJ	P,BKMAP
	MOVEM	TAC,(TEM)
	AOS	TEM,DMPBUF(DDB)		;BUMP COMMAND POINTER
	HLRZ	TAC,TEM			;END CHECK COMMAND LIST
	CAIGE	TAC,-100(TEM)
	JRST	EDMPLS			;ILL FMT COMMAND LIST.
	MOVE	TAC,DSKFAD(DDB)
	CAME	TAC,DSKLAD(DDB)		;SEE IF REQUEST COMPLETED
	PUSHJ	P,TSTRET		;START XFER IF GRP OFLOW
	JRST	DDIGO			;RTVL NOT IN MEANS GRP OFLOW
	JRST	DDIC1			;NO OFLOW YET, DO MORE

DDIGO:	MOVEI	DAT,DIDMPI		;START I-LEVEL SUBR
	PUSHJ	P,QEWAIT
	TRNE	IOS,IODERR!IODTER	;IF DEVICE SCREW-UP
	POPJ	P,			;QUIT NOW!
	MOVE	TAC,DSKFAD(DDB)
	CAME	TAC,DSKLAD(DDB)
	JRST	DDIC0			;WORDS LEFT; DO ANOTHER GROUP
	TLNN	IOS,IOEND		;END FILE?
	AOJA	UUO,DDICO2		;NO, DO NEXT IOWD

DDMIEF:	IOR	IOS,[XWD IOEND,IODEND]
	JRST	DSIOS			;STORE IOS, AND POPJ.

;*** INTERRUPT SUBR ***

DIDMPI:	MOVE	TEM,DMPBUF(DDB)
	HLRS	TEM
	MOVEI	TAC1,IOPCHN
	MOVSM	TAC1,TFRCTL(DDB)
DIDMI1:	MOVE	TAC1,(TEM)		;WCMA FROM COMMAND LIST
	MOVEM	TAC1,TFRIOW(DDB)
	MOVE	TAC1,1(TEM)
	MOVEM	TAC1,TFRSEC(DDB)
	PUSHJ	P,TSTART
	ADDI	TEM,2
	CAMGE	TEM,DMPBUF(DDB)
	JRST	DIDMI1

DIDMI2:	MOVE	TAC,DSKFAD(DDB)
	CAMN	TAC,DSKLAD(DDB)		;IF LAST TFR,JUST RETURN
	POPJ	P,
	SKIPN	TAC,DNXTGP(DDB)		;ELSE GET RTVL FOR NEXT GRP.
	JRST	DMIEF1			;FLAG END
	PUSHJ	P,BK2SEC
	MOVEM	TAC,TFRSEC(DDB)
	MOVEI	TAC,DSKDAT(DDB)		;READ RIGHT INTO DDB
	HRLI	TAC,-SECSIZ
	MOVEM	TAC,TFRIOW(DDB)
	PUSHJ	P,TSTART
	PUSHJ	P,AUDCHK
	POPJ	P,

DMIEF1:	TLO	IOS,IOEND
	POPJ	P,
;DUMP MODE OUTPUT

DDMPO:	TLNN	IOS,WRITEB!ALTERB
	JRST	ENOENT
	TLO	IOS,IO!GOBIT		;FLAG OUTPUT
	MOVEM	IOS,DEVIOS(DDB)
	PUSHJ	P,DDOCOM
	JRST	DDXIT

DDOCOM:	PUSHJ	P,GETCOR		;GET BUFFER FOR COMMAND LIST
DDOCO2:	PUSHJ	P,DMPCMD		;GET IOWD
	MOVEM	TAC1,CORFAD(DDB)
	MOVE	AC1,USETP(DDB)
	SUBI	AC1,1
	ASH	AC1,RECWSH
	MOVEM	AC1,DSKFAD(DDB)
	SUB	AC1,TAC			;TAC: -WD CT
	MOVEM	AC1,DSKLAD(DDB)
	CAMG	AC1,FILLNG(DDB)		;DID FILE GROW?
	JRST	DDOC0
	MOVEM	AC1,FILLNG(DDB)
	TLO	IOS,HDRDIF		;INDICATE NEW FILLNG TO SPREAD.
	MOVEM	IOS,DEVIOS(DDB)		;GET IT INTO THE DDB

DDOC0:	HLRS	DMPBUF(DDB)
DDOC1:	PUSHJ	P,MAKBLK
	JUMPE	TAC,SETLOS		;NON EX = BAD RETRIEVAL
	PUSHJ	P,DDCALC		;LOCATE BLOCK'S END.
	CAMLE	DAT,DSKLAD(DDB)		;COMPARE WORD COUNTS.
	MOVE	DAT,DSKLAD(DDB)
	SUB	DAT,DSKFAD(DDB)		;THIS GIVES TFR WORD COUNT.
	MOVN	TAC,DAT
	HRR	TAC1,CORFAD(DDB)
	HRL	TAC1,TAC		;PUT IN -WD COUNT
	AOS	TEM,DMPBUF(DDB)
	MOVEM	TAC1,-1(TEM)		;ENTER IN COMMAND LIST
	ADDM	DAT,CORFAD(DDB)		;UPDATE STARTING ADDRESSES
	ADDB	DAT,DSKFAD(DDB)
	ADDI	DAT,RECSIZ+RECSIZ-1
	ASH	DAT,-RECWSH
	MOVE	TAC,USETP(DDB)
	MOVEM	DAT,USETP(DDB)
	PUSHJ	P,LR2BLK
	JUMPE	TAC,SETLOS		;NON EX = BAD RETRIEVAL
	PUSHJ	P,BKMAP
	MOVEM	TAC,(TEM)
	AOS	TEM,DMPBUF(DDB)
	HLRZ	TAC,TEM
	CAIGE	TAC,-100(TEM)		;END CHK COMND LIST
	JRST	EDMPLS			;ILL FMT COMMAND LIST.
	MOVE	TAC,DSKFAD(DDB)
	CAMN	TAC,DSKLAD(DDB)		;ALL WORDS ACCOUNTED FOR?
	JRST	DDMPO4			;YES, DO OUTPUT
	PUSHJ	P,TSTRET		;RTVL NOT IN MEANS GRP OFLOW
	JRST	DDMPO3			;GRP OFLOW, DO OUTPUT
	JRST	DDOC1			;NO OFLOW, DO NEXT BLOCK

DDMPO3:	SKIPE	DNXTGP(DDB)		;NEXT GROUP EXIST?
	JRST	DDMPO4			;YES, OUTPUT THIS BLOCK.
	PUSHJ	P,ASNGRP		;NO, SET IT UP.

DDMPO4:	MOVEI	DAT,DIDMPO		;WRITE THIS GROUP OUT.
	PUSHJ	P,QEWAIT
	TRNE	IOS,IODERR!IODTER
	POPJ	P,			;QUIT NOW IF ERROR!
	MOVE	TAC,DSKFAD(DDB)
	CAME	TAC,DSKLAD(DDB)
	JRST	DDOC0			;WORDS LEFT, DO ANOTHER GROUP
	AOJA	UUO,DDOCO2		;GET NEXT IOWD

;***INTERRUPT SUBR***

DIDMPO:	TLZE	IOS,PNTDIF
	PUSHJ	P,SPREAD
	MOVE	TEM,DMPBUF(DDB)
	HLRS	TEM
	MOVEI	TAC1,DWRITE!IOPCHN
	MOVSM	TAC1,TFRCTL(DDB)
DIDMO1:	MOVE	TAC1,(TEM)
	HLRZ	DAT,PROG
	CAIL	DAT,(TAC1)
	JRST	DIDMO2
	LDB	DAT,PSEGN
	TRZ	TAC1,400000		;BELIEVE ME FRED THIS IS THE ONLY WAY!
	HRRZ	DAT,JBTADR(DAT)		;RPH 4-17-72
 	ADDI	TAC1,(DAT)		;RELOCATE TO UPPER
	JRST	DIDMO3

DIDMO2:	ADDI	TAC1,(PROG)
DIDMO3:	MOVEM	TAC1,TFRIOW(DDB)
	MOVE	TAC1,1(TEM)
	MOVEM	TAC1,TFRSEC(DDB)
	PUSHJ	P,TSTART
	ADDI	TEM,2
	CAMGE	TEM,DMPBUF(DDB)
	JRST	DIDMO1
	POPJ	P,
;BOTH INPUT & OUTPUT CLOSE ARE ALWAYS CALLED FROM UUOCON.
;CLOSE INPUT.

DCLOSI:	TLNE	IOS,IOSET
	JRST	DSIOS			;FAKE FOR USETI, RETURN.
	TLZE	IOS,READB
	TLZN	IOS,DELETB		;DELETE FILE (SUBSEQUENT ENTER)?
	JRST	DSIOS			;NO, JUST RETURN.
	JSP	AC1,ACCESS		;IS ANYONE ELSE READING?
	JRST	DSIOS			;YES, DON'T DELETE.
	JFCL				;IRRELEVANT
	PUSHJ	P,GOSET			;MAKE US UNSTOPPABLE.
	MOVE	TAC,FILLOC(DDB)		;NO ONE ELSE LOOKING, SO...
	PUSHJ	P,DELETE		;DELETE FILE.
	PUSHJ	P,CUSATO		;OUT SAT IF NEEDED.
	PUSHJ	P,WSYNC			;WAIT FOR IT
	JRST	DPOPJ


;CLOSE OUTPUT

DCLOSO:	TLNN	IOS,WRITEB!ALTERB
	JRST	DCLSDD			;NO ENTER, BLAST DDB
	PUSHJ	P,GOSET
	TLNN	DDB,OUTBFB+OUTPB	;ANY OUTPUT BUFFERS SET UP?
	JRST	DCLSO3			;NO.  NOTHING TO FLUSH  --ME
	LDB	TAC,PIOMOD		;#-EATING APRSER SHOULD DO THIS
	CAIGE	TAC,DR
	PUSHJ	P,OUT			;LAST OUTPUT FOR BUFFERED MODES
DCLSO3:	PUSHJ	P,WAIT1			;FINISH IT 
	TLNE	IOS,IOSET		;WERE WE CALLED FROM USETO?
	JRST	DPOPJ			;YES. CLEAR GOBIT AND RETURN.
	MOVEI	DAT,DCLOI
	TLNE	IOS,PNTDIF!HDRDIF	;RTVL CORRECT?
	PUSHJ	P,NEWAIT		;NO, GO FIX
	PUSHJ	P,RTNCOR		;IF OUTPUT ABORTED

;FILE & POINTERS NOW OUT; FIX UP UFD

DCLSO1:	TLNN	IOS,NTRUFD		;CHANGE UFD?
	JRST	DCLSO2			;NO, NEW FILE; UFD POINTS TO IT
DCLSO9:	TLZ	IOS,DELETB		;NEW VERSION OF OLD FILE.
	MOVSI	AC2,DELETB
	JSP	AC1,ACCESS		;MARK READERS OF OLD FILE...
	JRST	DCLSOR			;TO DELETE IT WHEN THRU
	JRST	ELOSE			;SHOULD BE JUST US WRITING
	PUSHJ	P,UFDSRC		;GET UFD RTVL
	MOVEI	DAT,DRAUFD		;USE RENAME CODE TO...
	PUSHJ	P,QEWAIT		;CHANGE UFD TO NEW FILE
	TLZE	IOS,DELETB		;WAS ANYONE READING?
	JRST	DCLSO2			;YES, DON'T DELETE NOW
DCLSOC:	MOVE	TAC,SRCLOC(DDB)		;OLD FILE LOCATION
DCLSOD:	PUSHJ	P,DELETE		;DELETE IT
DCLSO2:	PUSHJ	P,CUSATO		;OUT SAT IF NEEDED
	PUSHJ	P,WSYNC			;WAIT FOR IT

DCLSDD:	TDNE	IOS,[XWD DEVSBB,IOACT]
	SETZB	IOS,DEVIOS(DDB)		;THIS SHOULDN'T HAPPEN, BUT IT DOES.
	MOVSI	TAC,DEVIBF
	ANDCAM	TAC,DEVCMR(DDB)
	PUSHJ	P,RTNCOR
	SETZM	ACCNAM(DDB)
	HRLI	TAC,ACCNAM(DDB)
	HRRI	TAC,ACCNAM+1(DDB)
	BLT	TAC,DDEND-1(DDB)
	ANDI	IOS,GARBIT!DMPBIT!17
	JRST	DPOPJ

DCLSOR:	IORM	AC2,DEVIOS(TAC)		;FOUND READER, MARK TO DELETE
	TLO	IOS,DELETB		;FLAG FILE STILL IN USE
	JRST	ACCES1			;KEEP LOOKING


; *** INTERRUPT LEVEL ROUTINE ***
; UPDATE FIRST RTVL (LENGTH) &∨ LAST (PTRS).

DCLOI:	TLZN	IOS,HDRDIF		;HEADER PTRS OK?
	JRST	DCLSO5			;YES, FIX LAST PTRS
	MOVEI	TAC,1			;HEADER IS WRONG
	CAMN	TAC,DGRP1R(DDB)		;LOOKING AT HEADER?
	JRST	DCLSO5			;YES, GO FIX IT
;	TLNN IOS,PNTDIF		;LAST POINTERS OK?
	PUSHJ	P,DCLSO5		;NO, FIX THEM TOO
	MOVEI	TAC,1
	MOVEM	TAC,USETP(DDB)
	PUSHJ	P,GGRETI		;GET HEADER POINTERS
DCLSO5:	PUSHJ	P,AUDINF		;FIX UP
DCLSO4:	PUSHJ	P,SPREAD		;OUTPUT POINTERS
	TLNE	IOS,HDRDIF		;WERE BLOCKS REASSIGNED AT INTERRUPT LEVEL?
	JRST	DCLOI			;YES.
	POPJ	P,
;RELEASE UUO, CALL RESET, AND CALL EXIT

DRELES:	PUSHJ	P,WAIT1			;MAKE SURE RESET WAITS FOR DISK TO STOP
	PUSHJ	P,DCLOSI		;MAYBE DELETE FILE WE READ.
	TLNN	IOS,WRITEB		;IS A PARTIALLY WRITTEN FILE?
	JRST	DCLSDD			;NO, CLEAR DDB.
	PUSHJ	P,GOSET			;WE GET HERE ON RESET ONLY.
	MOVEI	DAT,DCLOI		;MAKE SURE RETRIEVAL IS OUT.
	PUSHJ	P,QEWAIT
	MOVE	TAC,FILLOC(DDB)
	TLNE	IOS,NTRUFD
	JRST	DCLSOD			;OLD FILE EXISTS, DELETE NEW
	PUSHJ	P,UFDSRC		;NEW FILE, DELETE NAME
	SETZM	ACCNAM(DDB)
	MOVEI	DAT,DRAUFD
	PUSHJ	P,QEWAIT
	JRST	DCLSOC			;THEN DELETE FILE.

;USETI, USETO, UGETF.

DSETI:	TLNN	IOS,READB
	JRST	ENOLUK
	PUSH	P,UUO			;SAVE THIS FOR LATER
	HRRI	UUO,CLSOUT		;DON'T AFFECT OUTPUT
DSETC0:	PUSHJ	P,DSETC			;FLUSH BUFFERS, FINISH IO
	POP	P,TAC1
	HRRE	TAC1,TAC1
	ADD	TAC1,DOFFST(DDB)	;ADD OFFSET
	SKIPG	TAC1			;IF LESS THAN 1
	MOVEI	TAC1,1			;MAKE IT 1 (LOSERS)
	PUSHJ	P,DGETL			;GET RECORD EOF+1
	CAMLE	TAC,TAC1		;SET TO END IF NOT IN FILE
	SKIPA	TAC,TAC1		;IT'S OK - USE IT
DSETC1:	TDOA	IOS,[XWD IOEND,IODEND]	;OFF END
	TDZ	IOS,[XWD IOEND,IODEND]	;INSIDE FILE, NO EOF
	MOVEM	TAC,USETP(DDB)		;STORE NEW POINTER
	TLNE	IOS,WRITEB!ALTERB	;COULD HE BE WRITING?
	SKIPN	TAC1,DGRP1R(DDB)	;AND DO WE HAVE ANY RETRIEVAL?
	JRST	DSIOS			;NOTHING TO DO
	CAIGE	TAC,RCPGRP(TAC1)
	CAIGE	TAC,(TAC1)		;IS NEW RECORD IN CURRENT RETRIEVAL?
	TLZN	IOS,PNTDIF		;NO, POINTERS NEED UPDATE?
	JRST	DSIOS			;NO UPDATE!
	MOVEI	DAT,DCLSO5
	PUSHJ	P,NEWAIT		;GO
	JRST	DSIOS			;STO IOS AND RETURN


DSETO:	TLNN	IOS,WRITEB!ALTERB
	JRST	ENOENT
	PUSH	P,UUO
	HRRI	UUO,CLSIN		;LEAVE INPUT ALONE
	JRST	DSETC0

DGETF:	PUSH	P,UUO
	MOVEI	UUO,CLSIN!CLSOUT
	TLNE	IOS,READB
	TRZ	UUO,CLSIN
	TLNE	IOS,WRITEB!ALTERB
	TRZ	UUO,CLSOUT
	PUSHJ	P,DSETC			;FLUSH BUFFERS, FINISH IO
	POP	P,UUO
	PUSHJ	P,DGETL			;NOW GET END OF FILE
	MOVE	TAC1,TAC		;SAVE COPY
	SUB	TAC1,DOFFST(DDB)	;UN-OFFSET FOR LOSER
	XCTR	XRW,[HRRM TAC1,(UUO)]	;GIVE TO USER
	JRST	DSETC1			;AND USETP TO THERE

DGETL:	MOVE	TAC,FILLNG(DDB)		;FIND NEXT FREE RECORD
↑DGETL1:ADDI	TAC,RECSIZ-1		;ROUND UP TO NEXT FULL RECORD
	ANDCMI	TAC,RECSIZ-1
	ASH	TAC,-RECWSH
	ADDI	TAC,1
	POPJ	P,

DSETC:	MOVSI	IOS,IOSET		;FLAG FOR CLOSE
	IORB	IOS,DEVIOS(DDB)		;FOR WAIT1 AT CLSOUT (UUOCON)
	PUSH	P,DDB
	PUSHJ	P,CLOSE1		;TO FLAG BUFFERS EMPTY.
	POP	P,DDB			;RE-OPEN
	TLZ	IOS,IOSET		;MAKE SURE THIS IS OFF!
	MOVEM	IOS,DEVIOS(DDB)
	HLLM	DDB,USRJDA(UCHN)	;AND REPLACE IN USER TABLE
	POPJ	P,
;MTAPE UUO -- BY R. HELLIWELL -- 16 JAN 72

;NEW FORMAT:
;	IF FIRST WORD IS -1 OLD MCQUIRE CODE:
;		-1
;		IOWD WC,MA
;	NEXT 2 WORDS ARE-
;		<DISK ADDRESS>
;		<     0      >		READ OR WRITE DISK BLOCK≠0
;	    OR
;		<DISK ADDRESS>
;		<     -1     >		TURN OFF SAT BIT FOR THIS BLOCK
;	    OR
;		<   0	>
;		<  ≠0	>		READ OR WRITE SAT TABLE(ON DISK)
;	    OR
;		<   0	>
;		<   0	>		FORCE SAT TABLE OUT FROM SYSTEM
;	    OR
;		<-1,,RELATIVE ADDRESS>
;		<ANYTHING>		READ OR WRITE WORD AT SATBIT
;					PLUS RELATIVE ADDRESS
;
;	LAST WORD:
;		<106>			WRITE (ONLY GOD MAY WRITE)
;		<ANYTHING ELSE>		READ
;
;
;	IF FIRST WORD = SIXBIT/GODMOD/	:
;		THEN SECOND WORD IS DISPATCH INTO GODDIS
;		SEE ROUTINE FOR FURTHER DESCRIPTION
;
;	ANYTHING ELSE IN FIRST WORD GETS THE USET POINTER!
DGETW:	PUSHJ	P,WAIT1			;FINISH ANYTHING IN PROGRESS
	XCTR	XR,[MOVE TAC,(UUO)]	;PICK UP FIRST ARG!!!
	CAMN	TAC,[-1]		;OLD MTAPE?
	JRST	UUOERR			;YES: OLD FORM OF MTAPE NO LONGER EXISTS
	CAME	TAC,['GODMOD']		;REQUESTING NEW GOD MODE
	JRST	GETPNT			;NO. GET THE USET POINTER
	ADDI	UUO,1
	XCTR	XR,[MOVE TAC,(UUO)]
	CAIL	TAC,GODLEN		;OFF END OF TABLE?
	JRST	UUOERR			;YES, TELL HIM HE LOST
	SKIPL	GODDIS(TAC)		;PROTECTED MTAPE?
	JRST	@GODDIS(TAC)		;NO, DISPATCH
	MOVE	TAC1,JBTPRV(J)		;YES, CHECK PRIV.
	TLNN	TAC1,INFPRV		;USE THIS PRIVILEGE
	JRST	UUOERR			;LOSER
	JRST	@GODDIS(TAC)

;IF SIGN BIT ON IN TABLE, MUST HAVE INFPRV TO DO THIS UUO!!!!!!!!

GODDIS:		GETPNT			;0	GET USET POINTER
	400000,,GDREAD			;1	READ DISK BLOCK
		GDWRIT			;2	WRITE DISK BLOCK
		SETSAT			;3	SET SAT BIT
		CLRSAT			;4	CLEAR SAT BIT
		SATRD			;5	READ WORDS FROM SAT TABLE
		SATWRT			;6	WRITE WORDS IN SAT TABLE
		SATFRC			;7	FORCE OUT SAT
	400000,,FILINF			;10	READ 5 WORDS OF FILE INFO
		WRTINF			;11	WRITE 5 WORDS OF FILE INFO
		DIAGL			;12	DIAGNOSTIC LOAD
		DIAGW			;13	DIAGNOSTIC WRITE
		GETRTR			;14	GET FILE RETRIEVAL DATA
		INFCOM			;15	COMPARE A WORD IN DQINFO
		ADDBLK			;16	FIX RETRIEVAL TO INCLUDE AN EXISTING BLOCK
		FILEUP			;17	UPDATE ALL POINTERS AND HEADER INFO
		RDOFF			;20	READ FILE RECORD OFFSET
		WRTOFF			;21	SET FILE RECORD OFFSET
GODLEN←←.-GODDIS

;	MTAPE CHN,[	≠-1 ∧ ≠SIXBIT/GODMOD/	]
;  OR
;	MTAPE CHN,[	SIXBIT/GODMOD/
;			0		];POINTER COMES BACK HERE

GETPNT:	MOVE	TAC,USETP(DDB)		;GET USET POINTER
	SUB	TAC,DOFFST(DDB)		;DO OFFSET
	XCTR	XW,[MOVEM TAC,(UUO)]	;AND GIVE IT TO USER
	POPJ	P,

;CHECK DISK ABSOLUTE WRITE PRIVILEGE
DGODZ:	MOVSI	AC1,DAWPRV
	TDNN	AC1,JBTPRV(J)		;SKIP IF DISK ABSOLUTE WRITE PRIV
	JRST	UUOERR			;LOSER
	POPJ	P,
;	GDWRIT, GDREAD
;CALL:
;	MTAPE CHN,[	SIXBIT/GODMOD/
;			1=READ 2=WRITE
;			IOWD WC,MA
;			XWD S <RECORD #>,<DISK BLOCK ADDRESS>	]
;	IO ERROR RETURN
;	SUCCESS RETURN
;IF THE SIGH BIT (S) IS ON IN THE 4TH WORD THEN THIS TRANSFER WILL BE
;TO ONE OF THE EXTRA TRACKS AT THE END OF PACK 0.  THE BLOCK ADDRESS
;SHOULD BE RELATIVE TO THE END OF THE PACK.

GDWRIT:	XCTR	XR,[HRRZ TAC,2(UUO)]	;MUST NOT WRITE SAT DIRECTLY
	XCTR XR,[SKIPL 2(UUO)]		;DON'T BE FAKED OUT BY XTRA CYL WRITE
	JUMPE	TAC,UADRER		;(DON'T BE FOOLED BT A RECORD # - REG)
	PUSHJ	P,DGODZ			;IS HE LEGAL?
	SKIPA	TAC,[DWRITE!IOPCHN]	;MAKE IT A WRITE
GDREAD:	MOVEI	TAC,IOPCHN		;READ
	MOVSM	TAC,TFRCTL(DDB)		;WHICH DIRECTION
	XCTR	XR,[HLRZ TAC,1(UUO)]	;MAKE SURE ITS NOT TIC
	JUMPE	TAC,UADRER		;LOSE?
	PUSHJ	P,MTPACK		;CHECK AND RELOCATE IOWD!
	XCTR	XR,[SKIPGE TAC,2(UUO)]	;PICK UP DISK ADDRESS
	JRST GDRD1			;XTRA CYL TRANSFER
	HRRZ TAC,TAC
	CAILE	TAC,LSTADR		;OFF END?
	POPJ	P,			;LET THE USER FIGURE OUT WHAT'S WRONG. (REG)
GDRD2:	LSH	TAC,6			;POSITION FOR TRACK ADDRESS
	XCTR	XLB,[LDB TAC1,[POINT 6,2(UUO),17]]	;GET RECORD #
	CAILE	TAC1,RCPBLK		;LEGAL RECORD?
	JRST	UADRER
	IOR	TAC,TAC1		;MERGE ADDRESS
	XCTR XR,[SKIPGE 2(UUO)]
	TLO TAC,200000			;MARK AS XTRA CYL PACK 0 OP
	MOVEM	TAC,TFRSEC(DDB)		;STUFF INTO DDB
	XCTR	XR,[HLRO TAC,1(UUO)]	;GET WC AGAIN
	IMULI	TAC1,RECSIZ
	SKIPE	TAC1
	SUBI	TAC1,RECSIZ-SECSIZ
	SUB	TAC1,TAC		;AND "ADD" WC
	CAILE	TAC1,BLKWDS		;RUN OFF END OF BLOCK?
	JRST	UADRER
	PUSHJ	P,GOSET			;MAKE US UNSTOPPABLE
	SETOM	DDLOC(DDB)		;DISABLE DSKQCK
	MOVEI	DAT,TSTART		;JUST DO OP
	PUSHJ	P,QEWAIT		;DO IT
	SETZM	DDLOC(DDB)
DEPOPJ:	TRNE	IOS,IODERR!IODTER	;ANY ERRORS?
	JRST	DPOPJ			;YES, NO SKIP
	JRST	DPOPJ1			;NO, SKIP RETURN

MTPACK:	XCTR	XR,[HRRZ TAC1,1(UUO)]	;PICK UP ADDRESS
	ADDI	TAC1,1			;MAKE IT HONEST
	PUSHJ	P,RELOCA		;ADDRESS CHECK AND RELOCATE
	JRST	UADRER
	HRRM	TAC1,TFRIOW(DDB)	;SAVE IN DDB
	MOVE	TAC,TFRCTL(DDB)		;GET MAGIC BIT
	TLNN	TAC,DWRITE		;IS IT WRITE?
	JUMPL	TAC1,UADRER		;NO, MUST HAVE WRITE (IN CORE) PERMISSION
	XCTR	XR,[HRRZ TAC1,1(UUO)]
	XCTR	XR,[HLRO TAC,1(UUO)]
	SUB	TAC1,TAC		;COMPUTE LAST ADDRESS OF TRANSFER
	PUSHJ	P,RELOCB		;ADDRESS CHECK, RELOCATE AND TEST SAME SEGMENT
	JRST	UADRER
	XCTR	XR,[HLLZ TAC1,1(UUO)]
	HLLM	TAC1,TFRIOW(DDB)	;SAVE IN DDB
	POPJ	P,			;OK

GDRD1:	HRRZ TAC,TAC
	CAIL TAC,NXTRA0*TRKCYL*BKPTRK
	JRST UADRER
	JRST GDRD2
;	SETSAT, CLRSAT
;CALL:
;	MTAPE CHN,[	SIXBIT/GODMOD/
;			3=SET BIT	4=CLEAR BIT
;			DISK ADDRESS]
;
;	CLEAR OR SET SAT BIT CORRESPONDING TO DISK ADDRESS

SETSAT:	SKIPA	AC2,[IORM AC1,SATBIT(TAC)]
CLRSAT:	MOVE	AC2,[ANDCAM AC1,SATBIT(TAC)]
	PUSHJ	P,DGODZ				;MUST BE GOD TO TWIDDLE BITS
	XCTR	XR,[SKIPLE TAC,1(UUO)]		;GET BLOCK ADDRESS
	CAILE	TAC,LSTBIT			;IN SAT TABLE?
	JRST	UADRER				;NO
	SUBI	TAC,1
	IDIVI	TAC,=36
	MOVEI	AC1,1
	ROT	AC1,(TAC1)
	MOVE	TAC1,SATBIT(TAC)		;GET COPY OF OLD WORD
	XCT	AC2				;TURN BIT ON OR OFF
	XOR	TAC1,SATBIT(TAC)		;CHECK FOR CHANGE
	JUMPE	TAC1,CPOPJ			;RETURN NOW IF NO CHANGE
	XORM	TAC1,SATCHK			;UPDATE CHECKSUM
	CAMN	AC2,[IORM AC1,SATBIT(TAC)]	;DID WE TURN IT ON OR OFF?
	AOSA	DSKUSE				;ON, INC DSKUSE
	SOS	DSKUSE				;OFF, DEC DSKUSE
	POPJ	P,
;	SATWRT, SATRD, SATFRC
;CALL:
;	MTAPE CHN,[	SIXBIT/GODMOD/
;			5=READ  6=WRITE
;			IOWD WC,MA
;			RELATIVE ADDRESS IN SAT TABLE]
;
; ADDRESS IS RELATIVE TO SATTAB, NOT SATBIT!!!!!
; READ OR WRITE PORTIONS OF SAT TABLE IN CORE!

SATWRT:	PUSHJ	P,DGODZ			;CHECK FOR GOD
	PUSHJ	P,SATSUP		;SAT SET UP
	JFCL				;DON'T CARE, JUST  READING
	MOVSS	TAC			;SWAP POINTERS TO BLT INTO SYSTEM
	ADDI	TAC1,-1(TAC)		;GET LAST LOC
	BLT	TAC,(TAC1)		;AND DO BLT
	POPJ	P,

SATRD:	PUSHJ	P,SATSUP		;SAT SET UP
	JRST	UADRER			;WRITE PROT, LOSE
	ADDI	TAC1,-1(TAC)		;GET LAST LOC
	BLT	TAC,(TAC1)		;GIVE INFO TO LOSER!
	POPJ	P,

SATSUP:	XCTR	XR,[HRRZ TAC1,1(UUO)]	;PICKUP USER ADDRESS
	ADDI	TAC1,1			;MAKE IT HONEST
	PUSHJ	P,RELOCA		;ADDRESS CHECK AND RELOCATE
	JRST	UADRER
	JUMPL	TAC1,.+2		;SKIP AOS IF WRITE PROT
	AOS	(P)			;SKIP RETURN
	MOVE	TAC,TAC1		;SAVE IN TAC
	XCTR	XR,[HLRE AC2,1(UUO)]	;GET WC
	MOVNS	AC2			;MAKE IT POS!
	JUMPLE	AC2,UADRER		;MUST NOW BE POS!
	XCTR	XR,[HRRZ TAC1,1(UUO)]	;GET MA AGAIN
	ADD	TAC1,AC2		;COMPUTE LAST ADDRESS
	PUSHJ	P,RELOCB		;ADDRESS CHECK AND RELOCATE
	JRST	UADRER
	XCTR	XR,[SKIPGE AC1,2(UUO)]	;GET RELATIVE SAT ADDRESS
	JRST	UADRER
	MOVE	TAC1,AC2
	ADD	AC2,AC1			;GET RELATIVE END OF SAT
	CAILE	AC2,SATEND-SATTAB	;INSIDE SAT?
	JRST	UADRER			;NO
	HRLI	TAC,SATTAB(AC1)		;PUT CORE ADDRESS OF FIRST WORD IN TAC
	POPJ	P,			;RETURN TO DO BLT

;CALL:
;	MTAPE CHN,[	SIXBIT/GODMOD/
;			7		]
;
;FORCE SAT TABLE TO BE WRITTEN OUT!

SATFRC:	SETOM	SATFLG			;LET ANYBODY FORCE SAT OUT
	MOVEI	DAT,SATOUT
	JRST	NEWAIT			;WAIT FOR IT
;	FILINF, WRTINF
;CALL:
;	MTAPE CHN,[	SIXBIT/GODMOD
;			10
;			ADDRESS TO PUT INFO (5 WORDS)	]
;	ERROR RETURN, NO LOOKUP DONE
;	SUCCESS RETURN

FILINF:	TLNN	IOS,READB			;LOOKUP DONE?
	POPJ	P,				;NO
	XCTR	XR,[MOVE TAC1,1(UUO)]
	ADDI	TAC1,DQLEN-1			;CHECK END OF TRANSFER FIRST
	PUSHJ	P,RELOCA
	JRST	UADRER
	JUMPL	TAC1,UADRER
	XCTR	XR,[MOVE TAC1,1(UUO)]
	PUSHJ	P,RELOCB
	JRST	UADRER
	JUMPL	TAC1,UADRER
	HRLI	TAC1,DQINFO(DDB)		;GET INFO FROM HERE
	HRRZ	TAC,TAC1
	BLT	TAC1,DQLEN-1(TAC)
	JRST	CPOPJ1

;CALL:
;	MTAPE CHN,[	SIXBIT/GODMOD/
;			11
;			ADDRESS OF 5 WORDS TO WRITE INTO RETRIEVAL	]
;	ERROR RETURN
;	SUCCESS RETURN

WRTINF:	PUSHJ	P,DGODZ
	TDNE	IOS,[XWD DEVSBB,IOACT]
	PUSHJ	P,WAIT1
	SKIPE	FILNAM(DDB)		;NO FILE TO RENAME?
	TLNE	IOS,DELETB		;OR GOING AWAY?
	POPJ	P,			;LOSSAGE RETURN
	XCTR	XR,[MOVE TAC1,1(UUO)]
	ADDI	TAC1,DQLEN-1
	PUSHJ	P,RELOCA
	JRST	UADRER
	XCTR	XR,[MOVE TAC1,1(UUO)]
	PUSHJ	P,RELOCB
	JRST	UADRER
	HRLM	TAC1,(P)		;SAVE USER ADDRESS FOR BLT'S
	MOVE	TAC1,JBTSTS(J)
	TLNE	TAC1,JACCT		;DON'T PRINT THIS FOR LOGIN/OUT
	JRST	LINOUT
	PUSHJ	P,DISDATE
	PUSHJ	P,DISERR
	[ASCIZ/WRITE INFO, USER = /]
	DISARG SIX,<PRJPRG(J)>
	[ASCIZ/  PROGRAM = /]
	DISARG SIX,<JOBNAM(J)>
	[ASCIZ/  TTY/]
	DISARG LOC,<JBTLIN(J)>
	[ASCIZ/
FILE = /]
	DISARG SIX,<FILNAM(DDB)>
	[ASCIZ/./]
	DISARG SIX,<FILEXT(DDB)>
	[ASCIZ/[/]
	DISARG SIX,<FILPPN(DDB)>
	[ASCIZ/]

/]
	-1
LINOUT:	MOVEI	AC3,DQLEN		;GET BLOCK OF FREE STORAGE
	PUSHJ	P,UFSGET		;GET IT
	PUSH	P,AC1
	HLLZ	TAC1,-1(P)		;GET SAVED USER ADDR
	HRR	TAC1,AC1		;SYSTEM ADDR
	BLT	TAC1,DQLEN(AC1)		;SAVE WORDS IN FREE STORAGE
	PUSHJ	P,FILEUP		;FORCE OUT POINTERS IF NECESSARY
	POP	P,SRCTMP(DDB)		;SAVE ADDRESS
	TRZ	IOS,IODERR!IODTER	;NO ERRORS YET!
	TLO	IOS,RENAMB		;LOCK UP FILE WHILE WE'RE IN IT
	PUSHJ	P,GOSET			;LEST WE GET STOPPED
	PUSH	P,USETP(DDB)		;SAVE CURRENT USET
	MOVEI	DAT,WRTINS		;I SUBR
	PUSHJ	P,NEWAIT
	POP	P,USETP(DDB)		;RESTORE USET
	MOVE	AC1,SRCTMP(DDB)
	PUSHJ	P,FSGIVE		;RETURN BLOCK
	TLZ	IOS,RENAMB		;UNLOCK FILE
	JRST	DEPOPJ

;***** I-SUBR FOR SMEARING OUT 5 WORD CHANGE TO DQINFO *****
WRTINS:	MOVE	TAC,FILLOC(DDB)		;HERE IS WHERE WE START
	PUSHJ	P,NEWFIL		;INITIALIZE FILE
WRTIN1:	PUSHJ	P,GGRETI		;GET RETRIEVAL IN
	HRLZ	TAC1,SRCTMP(DDB)	;GET FREE STORAGE ADDRESS
	HRRI	TAC1,DQINFO(DDB)	;AND DDB ADDRESS
	BLT	TAC1,DQINFO+DQLEN-1(DDB);BLT IN 5 WORDS
	PUSHJ	P,SPREAD		;SPREAD RET. OVER GROUP
	SKIPN	DNXTGP(DDB)		;ANOTHER TO GO?
	POPJ	P,
	MOVEI	TAC,RCPGRP		;INC USET TO NEXT GROUP
	ADDM	TAC,USETP(DDB)
	JRST	WRTIN1			;AND LOOP
;	WRTOFF, RDOFF
;CALL:
;	MTAPE CHN,[	SIXBIT/GODMOD/
;			21
;			NEW FIRST RECORD	]
;	ERROR RETURN
;	SUCCESS RETURN

WRTOFF:	TDNE	IOS,[XWD DEVSBB,IOACT]
	PUSHJ	P,WAIT1
	SKIPE	FILNAM(DDB)		;NO FILE TO RENAME?
	TLNE	IOS,DELETB		;OR GOING AWAY?
	POPJ	P,			;LOSSAGE RETURN
	TLNE	IOS,WRITEB		;ALREADY WRITING?
	JRST	WOFFOK			;YES, OK
	MOVSI	DAT,100000		;CHANGE; IS IT LEGAL?
	MOVE	AC2,FILPPN(DDB)
	MOVE	AC3,FILPRO(DDB)
	JSP	AC1,PROTEK
WOFFOK:	XCTR	XR,[MOVE TAC1,1(UUO)]	;GET USER OFFSET REQUEST
	SOJL	TAC1,CPOPJ		;NORMALIZE AND TEST FOR TO SMALL
	PUSH	P,TAC1
	PUSHJ	P,FILEUP		;MAKE SURE POINTERS ARE OK
					;BEFORE DIDLING THEM
	POP	P,SRCTMP(DDB)
	TRZ	IOS,IODERR!IODTER	;NO ERRORS YET!
	TLO	IOS,RENAMB		;LOCK UP FILE WHILE WE'RE IN IT
	PUSHJ	P,GOSET			;LEST WE GET STOPPED
	PUSH	P,USETP(DDB)		;SAVE CURRENT USET
	MOVEI	DAT,WRTOFS		;I SUBR
	PUSHJ	P,NEWAIT
	POP	P,USETP(DDB)		;RESTORE USET
	TLZ	IOS,RENAMB		;UNLOCK FILE
	JRST	DEPOPJ

;***** I-SUBR FOR SMEARING OUT DOFFST CHANGE *****
WRTOFS:	MOVE	TAC,FILLOC(DDB)		;HERE IS WHERE WE START
	PUSHJ	P,NEWFIL		;INITIALIZE FILE
WRTOF1:	PUSHJ	P,GGRETI		;GET RETRIEVAL IN
	MOVE	TAC1,SRCTMP(DDB)	;GET NEW OFFSET
	MOVEM	TAC1,DOFFST(DDB)	;SET INTO RETRIEVAL
	PUSHJ	P,SPREAD		;SPREAD RET. OVER GROUP
	SKIPN	DNXTGP(DDB)		;ANOTHER TO GO?
	POPJ	P,
	MOVEI	TAC,RCPGRP		;INC USET TO NEXT GROUP
	ADDM	TAC,USETP(DDB)
	JRST	WRTOF1			;AND LOOP
;CALL:
;	MTAPE CHN,[	SIXBIT/GODMOD/
;			20
;			RECORD OFFSET STORED HERE
;			ACTUAL FILE LENGTH	]
;	ERROR RETURN
;	SUCCESS RETURN
RDOFF:	MOVE	TAC,DOFFST(DDB)
	ADDI	TAC,1
	XCTR	XW,[MOVEM TAC,1(UUO)]	;REPORT STARTING RECORD #
	MOVE	TAC,FILLNG(DDB)
	XCTR	XW,[MOVEM TAC,2(UUO)]	;REPORT ACTUAL FILE LENGTH
	POPJ	P,
;	DIAGL, DIAGW
;CALL:
;	MTAPE CHN,[	SIXBIT/GODMOD/
;			12
;			ADDRESS TO PUT DIAGNOSTIC (MUST BE 200 WORDS)
;			FLOPPY DISK ADDRESS	]
;	IO ERROR RETURN
;	SUCCESS RETURN

DIAGL:	XCTR	XR,[MOVE TAC1,1(UUO)]		;PICK UP ADDRESS OF 200 WORD BUFFER
	PUSHJ	P,RELOCA
	JRST	UADRER
	JUMPL	TAC1,UADRER			;MUST HAVE WRITE PERMISSION
	HRRZM	TAC1,TFRIOW(DDB)
	XCTR	XR,[HRRZ TAC1,1(UUO)]
	ADDI	TAC1,177
	PUSHJ	P,RELOCB
	JRST	UADRER
	XCTR	XR,[MOVE TAC,2(UUO)]		;PICK UP FLOPPY DISK ADDRESS
	CAILE	TAC,377				;MUST BE ONE BYTE
	JRST	UADRER
	DPB	TAC,[POINT 8,TFRSEC(DDB),7]	;PUT IN PLACE FOR PICK UP BY CHANNEL
	MOVSI	TAC,IOPCHN			;KLUDGE TO INDICATE READ
LWMERG:	MOVEM	TAC,TFRCTL(DDB)
	PUSHJ	P,GOSET				;LOCK HIM IN FOR THIS
	MOVEI	DAT,LWSTRT
	PUSHJ	P,QEWAIT			;START OP AND WAIT FOR IT
	JRST	DEPOPJ				;CHECK ERRORS AND UNLOCK

;CALL:
;	MTAPE CHN,[	SIXBIT/GODMOD/
;			13
;			ADDRESS TO GET DIAGNOSTIC FROM (MUST BE 200 WORDS)
;			ADDRESS TO PUT ERROR CODE (4 WORDS)	]
;	IO ERROR RETURN
;	SUCCESS RETURN

DIAGW:	PUSHJ	P,DGODZ
	XCTR	XR,[MOVE TAC1,1(UUO)]
	PUSHJ	P,RELOCA
	JRST	UADRER
	HRRZM	TAC1,TFRSEC(DDB)
	XCTR	XR,[MOVE TAC1,1(UUO)]
	ADDI	TAC,177
	PUSHJ	P,RELOCB
	JRST	UADRER
	XCTR	XR,[MOVE TAC1,2(UUO)]
	PUSHJ	P,RELOCA
	JRST	UADRER
	JUMPL	TAC1,UADRER		;LOSE IF WRITE PROTECTED
	HRRZM	TAC1,TFRIOW(DDB)
	XCTR	XR,[MOVE TAC1,2(UUO)]
	ADDI	TAC,3
	PUSHJ	P,RELOCB
	JRST	UADRER
	MOVSI	TAC,DWRITE!IOPCHN
	JRST	LWMERG

;DIAGNOSTIC I-SUBR ************
LWSTRT:	MOVEM	DDB,DXB
	MOVEM	J,DXJ
	MOVEM	P,DXP
	TRZ	IOS,IODERR!IODTER
	MOVE	TAC,TFRSEC(DDB)
	MOVEM	TAC,DXS
	MOVE	TAC,TFRIOW(DDB)
	MOVEM	TAC,DXW
	HLRZ	TAC,TFRCTL(DDB)
	MOVEM	TAC,DXC
	JRST	WLDIAG			;DISPATCH TO DEVICE DEPENDENT SUBR
;	GETRTR
;CALL:	
;	MTAPE	CHN,['GODMOD'
;			14
;		     IOWD WC,MA]	;WC≤40
;	<ERROR - NO LOOKUP OR ENTER>
;PLACE UP TO 40 WORDS OF FILE RETRIEVAL AT USER'S ADR.
;RETRIEVAL IS COPIED FROM THE DDB FOR THIS CHANNEL.
;USER MUST HAVE A FILE LOOKED UP SUCESSFULLY ALREADY.

;REG THIS PAGE

GETRTR:	TLNN	IOS,READB+WRITEB+ALTERB	;LOOKUP OR ENTER DONE?
	POPJ	P,			;NO
	XCTR	XR,[HRRZ TAC1,1(UUO)]	;GET HIS ADDRESS
	XCTR	XR,[HLRO TAC,1(UUO)]	;AND THE WC
	CAMGE	TAC,[-40]
	JRST	UADRER
	SUB	TAC1,TAC		;COMPUTE LAST ADDRESS OF TRANSFER
	PUSHJ	P,RELOCA		;
	JRST	UADRER
	JUMPL	TAC1,UADRER
	XCTR	XR,[HRRZ TAC1,1(UUO)]	;GET THE ADDRESS HE SAID
	ADDI	TAC1,1			;MAKE IT HONEST
	PUSHJ	P,RELOCB
	JRST	UADRER
	JUMPL	TAC1,UADRER
	HRLI	TAC1,DDNAM(DDB)		;GET INFO FROM HERE
	XCTR	XR,[HLRO TAC,1(UUO)]	;GET -WC
	MOVN	TAC,TAC			;+WC
	MOVE	AC2,TAC			;REMEMBER THE WC
	ADDI	TAC,(TAC1)		;ADD BEGINNING ADDRESS
	MOVEI	AC1,(TAC1)		;SAVE USER'S ADDRESS
	BLT	TAC1,-1(TAC)		;MOVE DATA
	MOVE	TAC,JBTPRV(J)		;GET THIS GUY'S PRIVILEGES
	CAILE	AC2,DQINFO-DDNAM	;DID THIS USER READ SPECIAL STUFF?
	TLNE	TAC,INFPRV		;IS HE ALLOWED TO SEE ALL RETRIEVAL?
	JRST	CPOPJ1			;PRIVILEGED OR DIDN'T ATTEMPT TO READ DQINFO
	SETZM	DQINFO-DDNAM(AC1)	;ZERO DQINFO
	MOVSI	TAC1,DQINFO-DDNAM(AC1)	;SOURCE
	HRRI	TAC1,DQINFO-DDNAM+1(AC1)	;DESTINATION OF BLT
	CAILE	AC2,DQINFO+DQLEN-DDNAM	;DOES WC EXCEED SPECIAL AREA?
	MOVEI	AC2,DQINFO+DQLEN-DDNAM	;YES. MAKE IT SMALLER.
	ADDI	AC2,-1(AC1)		;ADD TO MAKE LAST ADDRESS TO ZERO
	CAIL	AC2,(TAC1)		;IS THIS A NULL BLT?
	BLT	TAC1,(AC2)		;REAL BLT TO ZERO CORE.
	JRST	CPOPJ1			;RETURN.
;	INFCOM, ADDBLK, FILEUP
;CALL:	
;	MTAPE	CHN,['GODMOD'
;			15
;			0-4		;WHICH WORD TO COMPARE WITH
;		       DATA  ]		;DATA TO BE COMPARED
;	<NO LOOKUP OR ENTER OR COMPARE NOT EQUAL>
;THIS IS A UUO TO COMPARE A WORD FROM THE USER WITH ONE FROM
;THE SPECIAL 5 WORD RETRIEVAL BLOCK IN A FILE

INFCOM:	TLNN	IOS,READB!WRITEB!ALTERB
	POPJ	P,
	XCTR	XR,[MOVE TAC,1(UUO)]	;PICK UP INDEX INTO 5 WORD RETRIEVAL BLOCK
	JUMPL	TAC,UADRER		;CHECK IT
	CAIL	TAC,DQLEN
	JRST	UADRER
	ADDI	TAC,DQINFO(DDB)		;CALC ADDR OF WORD
	MOVE	TAC,(TAC)		;PICK IT UP
	XCTR	XR,[CAMN TAC,2(UUO)]	;EQUAL TO LOSERS WORD?
	AOS	(P)			;YES, SKIP
	POPJ	P,

;CALL:
;	MTAPE	CHN,['GODMOD'
;			16
;		     RECORD # (REAL, NOT OFFSET)]
;	<NO LOOKUP OR ENTER OR NON-EX BLOCK>
;THIS UUO ALLOWS THE USER(LOSER) TO INCLUDE AN
;EXISTING BLOCK IN HIS WORD COUNT!

ADDBLK:	TLNN	IOS,ALTERB!WRITEB!READB	;FILE OPEN SOMEHOW?
	POPJ	P,
	XCTR	XR,[SKIPG TAC,1(UUO)]	;PICK UP LOSERS REC. NO.
	POPJ	P,			;AVOID CONFUSION
	PUSH	P,USETP(DDB)		;SAVE OLD USET POINTER IN CASE HE LOSES
	ADD	TAC,DOFFST(DDB)		;DO OFFSET
	MOVEM	TAC,USETP(DDB)
	PUSHJ	P,GOSET			;MAKE US UNSTOPPABLE IN CASE BAD POINTER
	PUSHJ	P,GETRET		;GET RETRIEVAL FOR RECORD
	JRST	ADDLOS			;NO SUCH GROUP
	PUSHJ	P,LR2BLK		;THE GROUP EXISTS, DOES THE BLOCK?
	JUMPE	TAC,ADDLOS		;0 MEANS NO SUCH BLOCK
	SUB	P,[1,,1]		;BLOCK EXISTS, LOSE OLD USETP
	MOVE	TAC,USETP(DDB)		;NOW INCLUDE THIS BLOCK IN WC
	LSH	TAC,RECWSH		;MAKE IT WORDS
	CAMG	TAC,FILLNG(DDB)
	JRST	DPOPJ1			;ALREADY IN WC
	MOVEM	TAC,FILLNG(DDB)		;UPDATE FILE LENGTH
	TLNE	IOS,ALTERB!WRITEB	;WRITING?
	TLO	IOS,HDRDIF		;YES, MAKE SURE IT GETS WRITTEN OUT LATER
	TDZ	IOS,[IOEND,,IODEND]	;CAN'T BE EOF ANY MORE
	JRST	DPOPJ1

ADDLOS:	POP	P,USETP(DDB)		;NO SUCH RECORD, GET BACK OLD ONE
	JRST	DPOPJ			;AND GIVE ERROR RETURN

;CALL
;	MTAPE	CHN,['GODMOD'
;			17   ]
FILEUP:	TLNE	IOS,ALTERB!WRITEB	;FILE OPEN?
	TLNN	IOS,PNTDIF!HDRDIF	;YES, ANYTHING TO DO?
	POPJ	P,			;NO, NO-OP
	MOVEI	DAT,DCLOI
	JRST	NENTER			;ENTER REQUEST AND RETURN TO USER
;LOOKUP

DLOOK:	TLZ	IOS,IO!READB
	TLNE	IOS,WRITEB
	JRST	EXFIL				;THIS DDB IS ALREADY WRITING
	SETZM	FILNAM(DDB)			;DISABLE RENAME.
	JSP	AC1,ACCENT
	SKIPN	ACCNAM(DDB)			;WAS THE SPECIFIED NAME BLANK?
	JRST	ENOFIL				;YES. LOSE.
	PUSHJ	P,GOSET
	JSP	AC1,ACCESS			;CHECK WHO'S DIDDLING FILE
	JRST	DLK1				;READ ENTRY - BORROW DATA
	JRST	DLK2				;WRITE ENTRY
	PUSHJ	P,FILSRC			;SEARCH DIRECTORY FOR FILE
	SKIPG	SRCTMP(DDB)
	JRST	ENOFIL				;NOT FOUND, LOSE
	MOVE	TAC,SRCEXT(DDB)
	MOVEM	TAC,ACCEXT(DDB)
	MOVE	TAC,SRCPRO(DDB)
	MOVEM	TAC,ACCPRO(DDB)
	JRST	DLK3				;GO CHECK PROTECTION.

DLK2:	TLNN	TAC1,NTRUFD			;WRITING; IS THERE AN OLD FILE?
	JRST	ENOFIL				;JUST NEW ONE, REPORT NON EX
	JRST	ACCES1				;THERE IS AN OLD ONE, SEEK IT

DLK1:	MOVE	TAC1,FILEXT(TAC)		;READ ENTRY FOUND. - BORROW DATA
	MOVEM	TAC1,SRCEXT(DDB)
	MOVEM	TAC1,ACCEXT(DDB)
	MOVE	TAC1,FILPRO(TAC)		;STEAL DATA
	MOVEM	TAC1,SRCPRO(DDB)
	MOVEM	TAC1,ACCPRO(DDB)
	SKIPN	TAC1,FILLOC(TAC)
	MOVE	TAC1,SRCLOC(TAC)
	MOVEM	TAC1,SRCLOC(DDB)
	MOVE	TAC1,UFDPRO(TAC)
	MOVEM	TAC1,UFDPRO(DDB)
DLK3:	MOVSI	DAT,200000
	JSP	AC1,UPROTC			;CHECK READ ACCESS TO UFD
	MOVSI	DAT,200000			;CHECK READ PROTECTION.
	JSP	AC1,PROTEC
	TLO	IOS,READB
	PUSHJ	P,ACCEST			;OK, ACCESS ESTABLISHED
	SKIPLE	TAC,SRCLOC(DDB)			;REASONABLE ADDRESS?
	CAILE	TAC,LSTBIT			;IF NOT,
	JRST	EGARB1				;UFD HAS BAD POINTER IN IT.
	MOVEI	DAT,LOOKI
	PUSHJ	P,QEWAIT			;UPDATE TIMES, GET LENTGH
	TLNE	IOS,LOSBIG
	JRST	EGARB2				;WRONG FILE FOUND AT LOC.
	
DRPT:	MOVEI	AC1,3(UUO)			;END ADDRESS
	TRNE	IOS,DMPBIT			;UNLESS DMPBIT SET
	ADDI	AC1,2				;THEN 2 LONGER
	HLRZ	TAC,PROG
	CAIL	TAC,(AC1)			;ADDRESS IN LOWER?
	JRST	DRPT2				;ENDS IN LOWER
	TRNN	UUO,400000			;UPPER STARTING ADDRESS?
	JRST	ADRERR				;NO
	LDB	TAC1,PSEGN
	JUMPE	TAC1,ADRERR
	MOVE	TAC,JBTSTS(TAC1)
	TLNE	TAC,JWP				;WRITE PROTECTED?
	JRST	ADRERR				;YES, LOSE
	HLRZ	TAC,JBTADR(TAC1)
	CAIGE	TAC,-400000(AC1)		;END IN UPPER?
	JRST	ADRERR				;NO, LOSE
	HRRZ	TAC,JBTADR(TAC1)
	SUBI	TAC,400000
	JRST	DRPT1

DRPT2:	HRRZ	TAC,PROG
DRPT1:	ADDI	TAC,(UUO)			;REPORT DATA TO USER
	PUSH	TAC,FILEXT(DDB)
	PUSH	TAC,FILPRO(DDB)
	MOVN	TAC1,DDLNG(DDB)
	TLNE	IOS,ALTERB			;ARE WE GETTING INTO ALTER MODE?
	MOVN	TAC1,FILLNG(DDB)		;YES, USE HONEST FILE LENGTH!
	MOVNM	TAC1,FILLNG(DDB)
	MOVE	AC1,DOFFST(DDB)
	LSH	AC1,RECWSH			;MAKE IT WORDS
	ADD	TAC1,AC1			;REPORT ADJUSTED SIZE TO USER
	SKIPLE	TAC1
	SETZ	TAC1,				;ACCOUNT FOR DOFFST BEING EOF
	MOVSS	TAC1
	PUSH	TAC,TAC1
	MOVE	TAC1,DREFTM(DDB)		;BEGIN RPH 3-8-73
	MOVEM	TAC1,REFTIM(DDB)		;UPDATE THIS CRUFT
	TRNE	IOS,DMPBIT
	PUSH	TAC,TAC1
	MOVE	TAC1,DDMPTM(DDB)
	MOVEM	TAC1,DMPTIM(DDB)
	TRNE	IOS,DMPBIT
	PUSH	TAC,TAC1			;END RPH

DLOK:	PUSHJ	P,DGETL
	MOVE	TAC1,DOFFST(DDB)
	ADDI	TAC1,1				;INIT USETP POINTER TO OFFSET
	CAMLE	TAC,TAC1			;DOFFST INSIDE FILE?
	MOVE	TAC,TAC1			;OK, USE DOFFST
	MOVEM	TAC,USETP(DDB)

DPOPJ1:	AOS	(P)
DPOPJ:	TLZ	IOS,GOBIT
	MOVEM	IOS,DEVIOS(DDB)
	CONSZ	PI,177B27			;ARE WE AT UUO LEVEL?
	POPJ	P,				;NO, CAN'T DO ANYTHING HERE!
	PUSH	P,AC3
	MOVE	J,JOB(PID)
	MOVE	AC3,JBTLIN(J)
	CAMN	AC3,[-1]			;DETACHED?
	JRST	DPJRA3
	PUSH	P,AC2
	PUSH	P,AC1

	MOVSI	AC1,DLYBIT
	MOVSI	AC2,COMBIT
	CONO	PI,SCNOFF			;KEEP SCANNER OUT.
	TDNN	AC1,TTYTAB(AC3)			;SKIP IF COMMAND DELAYED
	JRST	DPJRSC				;NO DELAYED COMMAND
	ANDCAM	AC1,TTYTAB(AC3)			;TURN OFF DELAY BIT
	TDNE	AC2,TTYTAB(AC3)			;ANOTHER COMMAND ALREADY IN?
	JRST	DPJRSC				;YES.
	AOS	COMCNT				;COUNT ANOTHER TTY NEED SCANNING
	IORM	AC2,TTYTAB(AC3)			;TURN ON COMMAND BIT
IFN FTTTYBUG,<
	PUSHJ	P,COMBCK
	PUSHJ	P,CNTCOM			;MAKE SURE ALL IS WELL
>
	CONO	PI,SCNON

	PUSHJ	P,WSCHED
DPJRST:	POP	P,AC1
	POP	P,AC2
DPJRA3:	POP	P,AC3
	POPJ	P,

DPJRSC:	CONO	PI,SCNON
	JRST	DPJRST

GOSET:	TLO	IOS,GOBIT
DSIOS:	MOVEM	IOS,DEVIOS(DDB)
	POPJ	P,

;*** INTERRUPT SUBR ***

LOOKI:	MOVE	TAC,SRCLOC(DDB)			;GET RTVL INTO DDB
	MOVEM	TAC,FILLOC(DDB)
	PUSHJ	P,NEWFIL
	PUSHJ	P,GETBLK
	PUSHJ	P,AUDCHK
	TRNE	IOS,DMPBIT			;MAKE THIS TRNE IF REFTIM REQUIRED
	POPJ	P,
	MOVE	TAC1,THSDAT			;USE DATE ONLY FOR REFERENCE TIME
	CAMG	TAC1,DREFTM(DDB)		;DON'T UPDATE MORE THAN ONCE A DAY
	POPJ	P,
	SKIPN	TTYLOK				;IN MAINTMODE, DON'T WRITE 
	SKIPE	MAINTM
	POPJ	P,
	MOVEM	TAC1,REFTIM(DDB)
	MOVEM	TAC1,DREFTM(DDB)
	MOVEM	TAC1,DREFTM+SYSRTV
	MOVE	TAC,[XWD -40,SYSBUF]
	MOVEM	TAC,TFRIOW(DDB)			;DON'T REWRITE WHOLE BLK.
	JRST	RERITE
;ENTER

DENTER:	JSP	AC1,ACCENT
	SKIPN	ACCNAM(DDB)
	JRST	ENOFIL				;BLANK NAME LOSES
	TLNE	IOS,READB			;HAS LOOKUP BEEN DONE?
	JRST	DALTER				;YES, IS ALTER
	SETZM	FILNAM(DDB)			;DISABLE RENAME.
	SETOM	SRCTMP(DDB)			;INITIALIZE FLAG
	JSP	AC1,ACCESS			;SEE WHO'S LOOKING
	JRST	DENT0				;READ - SAVE DATA 
	JRST	EFWRIT				;WRITE - LOSE
	TLO	IOS,IO!WRITEB!GOBIT
	PUSHJ	P,ACCEST			;ACCESS OURS
	SKIPG	SRCTMP(DDB)			;WAS SOMEONE READING?
	PUSHJ	P,FILSRC			;NO, GET DATA
	TLZ	IOS,WRITEB!NTRUFD		;TURN OFF IN CASE PROTECTION CHECK
	MOVEM	IOS,DEVIOS(DDB)			;   FAILS
	MOVSI	DAT,100000
	JSP	AC1,UPROTC
	SKIPG	SRCTMP(DDB)			;THIS NAME IN USE?
	JRST	DENT1				;NO FILE FOUND
	MOVSI	DAT,100000			;FOUND, CHECK PROTECTION.
	JSP	AC1,PROTEC			;WRITE ACCESS REQUIRED.
	LDB	AC1,[POINT 9,FILPRO(DDB),8]
	JUMPN	AC1,DENT1A			;JUMP IF USER SPECIFIED PROTECTION
	LDB	AC1,[POINT 9,SRCPRO(DDB),8]	;USE OLD FILE'S PROT
	DPB	AC1,[POINT 9,FILPRO(DDB),8]	;...AS NEW FILE'S PROTECTION
DENT1A:	TLOA	IOS,NTRUFD!WRITEB		;INDICATE CHANGE UFD AT CLOSE.
DENT1:	TLOA	IOS,WRITEB			;NEW NAME. PUT IN UFD NOW.
	SKIPA	TAC1,SRCEXT(DDB)		;USE OLD CREATION DATE AS DEFAULT
	MOVE	TAC1,THSDAT			;USE CURRENT DATE AS DEFAULT
	LDB	TAC,[POINT 15,ACCEXT(DDB),35]	;BELIEVE ANY CREATE DATE
	JUMPN	TAC,DENT4			;USER TELLS US.
	MOVE	TAC,TAC1
	DPB	TAC,[POINT 15,ACCEXT(DDB),35]
DENT4:	DPB	TAC,[POINT 15,FILEXT(DDB),35]
DENT2:	MOVEM	IOS,DEVIOS(DDB)
	TRNE	IOS,DMPBIT
	JRST	DENT3				;DON'T INIT TIME IF DUMPER
	SETZM	DDMPTM(DDB)			;NEW FILE NEVER DUMPED.
	SETZM	DMPTIM(DDB)
	MOVE	TAC1,THSDAT			;REFERENCE DATE
	MOVEM	TAC1,REFTIM(DDB)
	MOVEM	TAC1,DREFTM(DDB)
	PUSHJ	P,DSKTM1			;GET DATE AND TIME LAST WRITTEN
	DPB	TAC,[POINT 3,ACCEXT(DDB),20]	;STORE EXTRA BITS
	DPB	TAC,[POINT 3,FILEXT(DDB),20]
	MOVSI	TAC,777000			;USE SPECIFIED PROTECTION
	AND	TAC,FILPRO(DDB)			;GET PROTECTION THUS FAR
	JUMPN	TAC,DENT2A			;JUMP IF THERE'S NON-ZERO ALREADY
	TLNE	IOS,NTRUFD			;SKIP IF NEW FILE.
	JRST	DENT2A				;REPLACING OLD FILE - KEEP 0 PROT
;HERE WE USE UFD'S DEFAULT PROTECTION WORD FOR PROTECTION OF THIS NEW FILE
	MOVEI	TAC,777000
	AND	TAC,UFDPR1(DDB)			;DEFAULT PROTECTION VALUE FROM UFD
	MOVSI	TAC,(TAC)
DENT2A:	OR	TAC1,TAC
	DPB	IOS,[POINT 4,TAC1,12]		;DATA MODE
	MOVEM	TAC1,FILPRO(DDB)
	MOVEM	TAC1,ACCPRO(DDB)
	MOVSI	IOS,HDRDIF
	IORB	IOS,DEVIOS(DDB)			;MAKE SURE DATE GOES OUT EVENTUALLY
DENT3:	TLNE	IOS,ALTERB
	JRST	ENTREN				;PUT OUT DATE IF ALTER MODE
	MOVE	TAC,DSKUSE			;SEE IF ANY SPACE LEFT
	CAILE	TAC,LSTBIT-=200			;SOFT STOP WITH 200K DISK LEFT.
	JRST	ENTFUL				;GIVE NO ROOM MESSAGE. ERROR RETURN
	PUSHJ	P,ASNBLK			;GET SPACE FOR NEW FILE
	MOVEM	TAC,FILLOC(DDB)
	MOVE	TAC,DDLOC(DDB)			;UFD LOCN FOR DIRINS
	MOVEM	TAC,SRCLOC(DDB)
	TLNN	IOS,NTRUFD
	PUSHJ	P,DIRINS			;NEW FILE TO UFD NOW.
	SETZM	FILLNG(DDB)
	SETZM	DQINFO(DDB)			;INITIALIZE MAGIC FILE INFO
	SETZM	DQINFO+1(DDB)
	HLRZ	TAC,FILEXT(DDB)
	CAIE	TAC,UFDEXT
	JRST	NENUFD				;NOT ENTERING A UFD
	MOVE	TAC,FILPPN(DDB)
	CAME	TAC,SYSPPN
	JRST	NENUFD
	SETZM	DQINFO+2(DDB)			;CLEAR WORDS WHEN ENTERING A UFD
	SETZM	DQINFO+3(DDB)
	JRST	WENUFD

NENUFD:	MOVE	TAC,JOBNAM(J)			;UPDATE PPN AND JOB OF WRITER
	MOVEM	TAC,DQINFO+2(DDB)
	MOVE	TAC,PRJPRG(J)
	MOVEM	TAC,DQINFO+3(DDB)
WENUFD:	SETZM	DOFFST(DDB)			;INIT OFFSET
	PUSHJ	P,AUDINF
	MOVE	TAC,FILLOC(DDB)
	PUSHJ	P,NEWFI1
	PUSHJ	P,ASNGR1			;SET UP RTVL
	MOVEI	DAT,SPREAD
	TLNN	IOS,NTRUFD			;IF NEW FILE,
	PUSHJ	P,QEWAIT			;PUT RTVL OUT.
	JRST	DRPT				;REPORT DATA TO USER.

DENT0:	MOVE	TAC1,FILPRO(TAC)		;READER FOUND, SAVE PROTECTION.
	MOVEM	TAC1,SRCPRO(DDB)
	MOVE	TAC1,FILEXT(TAC)
	HRRM	TAC1,SRCEXT(DDB)
	MOVE	TAC1,UFDPRO(TAC)
	MOVEM	TAC1,UFDPRO(DDB)
	MOVEI	TAC1,1				;SET FLAG: ITEM FOUND
	MOVEM	TAC1,SRCTMP(DDB)
	JRST	ACCES1				;KEEP LOOKING FOR WRITERS

ENTREN:	PUSHJ	P,ALTREN			;WRITE DATE INTO UFD
	JFCL					;CAN'T GET ERROR RETURN???
	JRST	DRPT				;RETURN LOOKUP INFO

DALTER:	TLOE	IOS,ALTERB
	JRST	EFWRIT				;ALREADY ALTERING
	MOVE	TAC,FILNAM(DDB)			;SAME FILE?
	CAME	TAC,ACCNAM(DDB)
	JRST	EANAME
	HLLZ	TAC,FILEXT(DDB)
	HLLZ	TAC1,ACCEXT(DDB)
	CAME	TAC,TAC1
	JRST	EANAME
	MOVE	AC2,FILPPN(DDB)
	CAME	AC2,ACCPPN(DDB)
	JRST	EANAME
	MOVSI	DAT,100000
	JSP	AC1,UPROTC			;SEE IF UFD ALLOWS THIS ACCESS
	MOVSI	DAT,100000			;NEEDS WRITE ACCESS
	MOVE	AC3,FILPRO(DDB)
	JSP	AC1,PROTEK
	JSP	AC1,ACCESS			;IS ANYONE USING FILE?
	JRST	EFWRIT				;IF SO, LOSE
	JRST	EFWRIT
	JRST	DENT2				;STORE IOS & SKIP RETURN.
;RENAME

DRENAM:	TDNE	IOS,[XWD DEVSBB,IOACT]
	PUSHJ	P,WAIT1				;FINISH CURRENT BUSINESS
	SKIPN	FILNAM(DDB)
	JRST	EXFIL				;LOSE IF NO ACCESSED FILE.
	TLNE	IOS,NTRUFD!DELETB		;IF FILE TO BE DELETED,
						;OR OVERWRITING AND NO CLOSE
	JRST	ENOFIL				;CAN'T RENAME.
	TLNN	IOS,READB			;IF READING, TEST UNIQUE ACCESS.
	JRST	DRE0				;OTHERWISE, ALREADY UNIQUE.
	XCTR	XR,[MOVE AC2,(UUO)]		;NEW FILE NAME
	JSP	AC1,ACCESS			;IS ANYONE ELSE RENAMING FILE?
	JUMPN	AC2,EFWRIT			;LOSE UNLESS DELETING
	JFCL					;CAN'T AFFECT FOREIGN WRITER
DRE0:	PUSHJ	P,FILEUP			;FORCE RETRIEVAL SO WE DON'T MUNG IT
	PUSHJ	P,GOSET
	TRNE	IOS,DMPBIT
	JRST	DRE0A				;DON'T INIT TIME IF DUMPER
	MOVE	TAC1,THSDAT			;GET REFERENCE DATE
	MOVEM	TAC1,REFTIM(DDB)		;UPDATE REFTIM FOR RANDOM LOSER
DRE0A:	JSP	AC1,ACCENT			;JUST US. PICK UP UUO ARGS.
	SKIPN	TAC,ACCNAM(DDB)
	JRST	DRNMC				;DELETING, CHECK WRITE PROT
	MOVE	TAC,ACCPRO(DDB)
	XOR	TAC,FILPRO(DDB)			;PROTECTION CHANGE?
	TLNN	TAC,777000
	JRST	DRE1				;NO CHANGE
	MOVE	AC2,FILPPN(DDB)
	CAME	AC2,SYSPPN
	JRST	DRE0B				;NOT ACCESS TO A UFD
	MOVE	AC2,FILNAM(DDB)			;UFD ACCESS.  TO MFD?
	CAMN	AC2,SYSPPN
	JRST	EPROT				;CHANGE PROT OF MFD NOT ALLOWED
	MOVE	AC1,JBTPRV(J)
	TLNN	AC1,PROPRV			;PRIVILEGED?
	CAMN	AC2,PRJPRG(J)			;NO. BUT ACCESS TO OWN UFD OK
	JRST	DRE1
	JRST	EPROT

DRE0B:	MOVSI	DAT,400000
	JSP	AC1,UPROTK			;LEGAL TO CHANGE IN THIS UFD?
	MOVSI	DAT,400000
	MOVE	AC3,FILPRO(DDB)
	JSP	AC1,PROTEK			;LEGAL TO CHANGE THIS FILE?

DRE1:	MOVE	TAC,FILNAM(DDB)
	CAME	TAC,ACCNAM(DDB)
	JRST	DRNMC				;NAME CHANGE.
	HLLZ	TAC1,FILEXT(DDB)
	XOR	TAC1,ACCEXT(DDB)
	TLNE	TAC1,777777			;EXT CHANGE?
	JRST	DRNMC
	MOVE	TAC1,FILPPN(DDB)
	CAME	TAC1,ACCPPN(DDB)		;NEW PROJ.-PROG?
	JRST	DRNMC				;YES, NEW PPN
ALTREN:	PUSHJ	P,FILSRC			;LITTLE OR NO CHANGE. GET RTVL IN.
	JRST	DRE2

DRNMC:	MOVSI	DAT,100000			;NAME CHANGE REQUIRES WRITE ACCESS
	MOVE	AC2,FILPPN(DDB)
	JSP	AC1,UPROTK			;UFD ALLOWS WRITE ACCESS?
	MOVSI	DAT,100000
	MOVE	AC3,FILPRO(DDB)
	JSP	AC1,PROTEK			;FILE ALLOWS WRITE ACCESS?
	JUMPE	TAC,DRDEL			;0 = DELETE.
	JSP	AC1,ACCESS			;NEW NAME; SEE IF IN USE.
	JRST	EDNAME
	JRST	EDNAME				;YES, LOSE.
	TLO	IOS,RENAMB			;ESTABLISH UNIQUE ACCESS NOW!
	MOVEM	IOS,DEVIOS(DDB)
	MOVE	AC3,UFDPRO(DDB)			;THIS GETS CLOBBERED BY FILSRC
	MOVEM	AC3,UFDPR1(DDB)
	PUSHJ	P,FILSRC			;SEE IF IN DIRECTORY.
	TLZ	IOS,RENAMB			;IN CASE OF ACCIDENT, RELEASE ACCESS
	MOVE	AC3,UFDPR1(DDB)			;GET BACK PROTECTION OF SOURCE UFD
	EXCH	AC3,UFDPRO(DDB)			;DESTINATION UFD PROTECTION IN AC3
	SKIPLE	TAC,SRCTMP(DDB)			;DOES FILE NAME EXIST?
	JRST	EDNAME				;FILE NAME IS IN USE. (STORES IOS)
	TRNN	IOS,DMPBIT
	SETZM	DMPTIM(DDB)			;CLEAR DUMP DATE, UNLESS DUMPER

DRE2:	TLO	IOS,RENAMB			;KEEP HACKERS OUT WHILE...
	MOVEM	IOS,DEVIOS(DDB)			;CHANGING THINGS.
	MOVE	TAC,DDLOC(DDB)			;POINTS TO DESTINATION UFD ALWAYS
	MOVEM	TAC,SRCLOC(DDB)			;TELL DIRSRC WHERE TO LOOK.
	MOVE	TAC,ACCPPN(DDB)			;COMPARE PPN
	CAMN	TAC,FILPPN(DDB)
	JRST	DREC1				;SAME PPN, CHANGE 1 UFD
	MOVSI	DAT,100000			;REQUIRES WRITE ACCESS TO OTHER UFD
	MOVE	AC2,ACCPPN(DDB)			;GET PPN OF DESTINATION. AC3 SETUP
	JSP	AC1,PROT0			;SEE IF ACCESS ALLOWED.
	MOVE	TAC,FILEXT(DDB)			;COPY CREATION DATE FROM RETRIEVAL
	DPB	TAC,[POINT 15,ACCEXT(DDB),35]	;INTO USERS VARIABLES
						;(WILL BE COPIED BACK LATER)
	TRNE	TAC,700000			;CHECK THIS PART OF DATE
	JRST	DRE3				;USER IS SPECIFYING DATE & TIME
	MOVE	TAC,ACCPRO(DDB)
	TDNE	TAC,[777,,777777]		;ANY DATE AND TIME?
	JRST	DRE3				;YES, USE IT
	MOVE	TAC,FILPRO(DDB)			;NO, USE THOSE FROM RETRIEVAL
	TLZ	TAC,777000			;CLEAR PROT.
	IORM	TAC,ACCPRO(DDB)
	LDB	TAC,[POINT 3,FILEXT(DDB),20]
	DPB	TAC,[POINT 3,ACCEXT(DDB),20]
DRE3:	PUSHJ	P,DIRINS			;CHANGE 2 UFD'S. INSERT NEW
	MOVEI	TEM,FILNAM(DDB)
	PUSHJ	P,SRCH1				;FIND OLD UFD
	SKIPA	DAT,[DR2INT]			;AND REMOVE OUR ENTRY
DREC1:	MOVEI	DAT,DRINT			;CHANGE 1 UFD ONLY
	MOVE	AC1,FILLNG(DDB)
	CAILE	AC1,=50*2000
	JRST	DRE8
	PUSHJ	P,QEWAIT
	JRST	DRE7

DRE8:	PUSHJ	P,NEWAIT
DRE7:	TLZA	IOS,RENAMB			;SEE US SAVE A WORD OF CODE.
DRDEL:	PUSHJ	P,DCLSO9			;ARRANGE TO DELETE FILE.
	JRST	DPOPJ1

;***INTERRUPT LEVEL SUBRS***

DRAUFX:	AOS	DRAUFO
	POPJ	P,

DRAUFD:	SKIPN	TAC,FILNAM(DDB)			;FIND ENTRY FOR OLD NAME
	JRST	DRAUFX				;NULL NAME? RETURN NO FILE FOUND.
	MOVEM	TAC,SRCNAM(DDB)			;(UFD WAS FOUND BY FILSRC)
	MOVE	TAC,FILEXT(DDB)
	HLLZM	TAC,SRCEXT(DDB)
	PUSHJ	P,DIRSRC			;FIND UFD ENTRY
	SKIPG	SRCTMP(DDB)
	JRST	DRAUFX				;NO OLD FILE FOUND!
	MOVE	TAC,ACCNAM(DDB)			;CHANGE IT
	MOVEM	TAC,SYSDTA+UNAM(TAC1)		;(ALSO USED FOR DELETE)
	MOVE	TAC,ACCEXT(DDB)
	HLLM	TAC,SYSDTA+UEXT(TAC1)
	MOVE	TAC,SYSDTA+UEXT(TAC1)		;NOW COPY CREATION DATE BACK
	DPB	TAC,[POINT 15,ACCEXT(DDB),35]	;RPH/DATE75
	LDB	TEM,[POINT 3,ACCEXT(DDB),20]	;GET DATE
	MOVE	TAC,ACCPRO(DDB)			;AND TIME
	TDNN	TAC,[777,,777777]		;DID HE SPECIFY ANY?
	JUMPE	TEM,UOLDAT			;CHECK IT ALL
	JRST	UNEWDA				;USER SPECIFYING DATE AND TIME

UOLDAT:	LDB	TEM,[POINT 3,FILEXT(DDB),20]	;COPY 3 EXTRA BITS
	DPB	TEM,[POINT 3,ACCEXT(DDB),20]
	MOVE	TAC,FILPRO(DDB)			;NOW REST OF DATE AND TIME
	DPB	TAC,[POINT 23,ACCPRO(DDB),35]
	MOVE	TAC,ACCPRO(DDB)
UNEWDA:	DPB	TEM,[POINT 3,SYSDTA+UEXT(TAC1),20]	;STORE BITS IN UFD ENTRY
	MOVEM	TAC,SYSDTA+UPRO(TAC1)			;AND THE REST TOO
	MOVE	TAC,FILLOC(DDB)				;NEW FILE LOCATION.
	EXCH	TAC,SYSDTA+UPPN(TAC1)		;OLD ONE USED BY CLOSE OUTPUT.
	MOVEM	TAC,SRCLOC(DDB)

REWRIT:	MOVEI	TAC,IOPCHN!DWRITE
	MOVSM	TAC,TFRCTL(DDB)
	PUSHJ	P,TSTART			;WRITE IT BACK OUT.
	POPJ	P,

DRINT:	PUSHJ	P,DRAUFD
DRINT1:	MOVE	TAC,FILEXT(DDB)
	PUSHJ	P,ACCST1			;UPDATE NAME.
	HRRM	TAC,FILEXT(DDB)			;RESTORE TIME
	MOVE	TAC,FILLOC(DDB)			;PREPARE TO SPREAD IT
	PUSHJ	P,NEWFIL

DRINL:	PUSHJ	P,GGRETI			;WRITE NEW NAME OVER FILE
	TLNN	IOS,ALTERB			;ARE WE ENTERING R-A MODE,
	JRST	DRINL2				;UPDATE JOB AND PPN OF CULPRIT
	HLRZ	TAC,FILEXT(DDB)			;EXCEPT FOR UFDS
	CAIE	TAC,UFDEXT
	JRST	DRINL1
	MOVE	TAC,FILPPN(DDB)
	CAMN	TAC,SYSPPN
	JRST	DRINL2
DRINL1:	MOVE	TAC,JOBNAM(J)
	MOVEM	TAC,DQINFO+2(DDB)
	MOVE	TAC,PRJPRG(J)
	MOVEM	TAC,DQINFO+3(DDB)
DRINL2:	PUSHJ	P,AUDINF			;COPY NEW INFO IN RETRIEVAL AREA
	PUSHJ	P,SPREAD
	SKIPN	DNXTGP(DDB)
	POPJ	P,				;END FILE, RETURN
	MOVEI	TAC,RCPGRP
	ADDM	TAC,USETP(DDB)
	JRST	DRINL

; WE GET HERE TO DELETE ENTRY IN OLD UFD
; PPN CHANGE ONLY
; ENTRY HAS ALREADY (SUPPOSEDLY) BEEN INSERTED IN NEW UFD

DR2INT:	PUSHJ	P,DIRSRC			;FIND ENTRY IN OLD UFD
	SKIPG	SRCTMP(DDB)			;IS IT REALLY THERE?
	JRST	DRAUFX				;NO, LOSE LOSE
	SETZM	SYSDTA+UNAM(TAC1)		;DELETE ENTRY IN UFD
	SETZM	SYSDTA+UEXT(TAC1)
	PUSHJ	P,REWRIT
	JRST	DRINT1				;SPREAD RETRIEVAL
;FILE ACCESS CONTROL.

ACCENT:	MOVE	J,JOB(PID)
	XCTR	XR,[MOVE TAC,UNAM(UUO)]		;NAME
	MOVEM	TAC,ACCNAM(DDB)
	XCTR	XR,[MOVE TAC,UEXT(UUO)]		;EXT
	MOVEM	TAC,ACCEXT(DDB)
	XCTR	XR,[MOVE TAC,UPRO(UUO)]		;PROT
	MOVEM	TAC,ACCPRO(DDB)
	XCTR	XR,[SKIPN TAC,UPPN(UUO)]	;PPN
IFN FTDSKPPN,<	SKIPE	TAC,DSKPPN(J)		;PICK UP DISK ALIAS PPN IF ANY
		CAIA			>;FTDSKPPN
	MOVE	TAC,PRJPRG(J)			;USE USER'S PPN IF BLANK
	TLNE	DDB,SYSDEV			;SYS?
	MOVE	TAC,CUSPPN			;YES, USE CUSP PPN
	MOVEM	TAC,ACCPPN(DDB)
	TRNN	IOS,DMPBIT
	JRST	(AC1)
	XCTR	XR,[MOVE TAC,4(UUO)]
	MOVEM	TAC,REFTIM(DDB)
	XCTR	XR,[MOVE TAC,5(UUO)]
	MOVEM	TAC,DMPTIM(DDB)
	JRST	(AC1)

ACCESS:	MOVEI	TAC,DSKDDB		;FIRST DDB IS DSK DUMMY
	HLLZ	DAT,ACCEXT(DDB)		;IN CASE RH NOT 0.
ACCES1:	HLRZ	TAC,DEVSER(TAC)		;GET NEXT DDB
	HLRZ	TAC1,DEVNAM(TAC)	;GET DEVICE NAME
	CAIE	TAC1,'DSK'		;IS IT "DSK"?
	JRST	2(AC1)			;NO, ALL DONE, RETURN
	CAIN	TAC,(DDB)		;DON'T LOOK AT OWN DDB
	JRST	ACCES1
	MOVE	TAC1,FILNAM(TAC)	;COMPARE NAME
	CAME	TAC1,ACCNAM(DDB)
	JRST	ACCES1
	HLLZ	TAC1,FILEXT(TAC)
	CAME	TAC1,DAT
	JRST	ACCES1
	MOVE	TAC1,FILPPN(TAC)
	CAME	TAC1,ACCPPN(DDB)
	JRST	ACCES1
	MOVE	TAC1,DEVIOS(TAC)	;FOUND ONE, SEE WHAT IT'S DOING
	TLNE	TAC1,DELETB
	JRST	ACCES1			;IGNORE IF TO BE DELETED.
	TLNE	TAC1,ALTERB!RENAMB	;ALTERING?
	JRST	EFWRIT			;YES, LOSE
	TLNE	TAC1,READB		;READING?
	XCT	0(AC1)			;YES
	TLNE	TAC1,WRITEB		;WRITING?
	XCT	1(AC1)			;YES
	JRST	ACCES1			;OK, LOOK FOR MORE.

ACCEST:	MOVEM	IOS,DEVIOS(DDB)			;ACCESS ESTABLISHED
ACCST1:	MOVE	TAC1,ACCNAM(DDB)
	MOVEM	TAC1,FILNAM(DDB)
	MOVE	TAC1,ACCEXT(DDB)
	MOVEM	TAC1,FILEXT(DDB)
	MOVE	TAC1,ACCPRO(DDB)
	MOVEM	TAC1,FILPRO(DDB)
	MOVE	TAC1,ACCPPN(DDB)
	MOVEM	TAC1,FILPPN(DDB)
	POPJ	P,

PROTEC:	MOVE	AC2,ACCPPN(DDB)
	MOVE	AC3,SRCPRO(DDB)
PROTEK:	CAMN	AC2,SYSPPN		;ACCESS TO A UFD?
	JRST	PROT3			;YES.
PROT0:	CAMN	AC2,PRJPRG(J)		;OWNER ACCESS TO FILE?
	JRST	PROT1			;YES.  DO OWNER ACCESS TESTS
	LSH	AC3,3			;NOT OWNER. SHIFT TO LOCAL-USER BITS
	MOVE	TAC1,JBTPRV(J)		;
	TLNN	TAC1,LUPPRV		;LOCAL USER?
	LSH	AC3,3			;NO. SHIFT TO REMOTE-USER FIELD
	LSH	TAC1,2			;SHIFT PRIVILEGE BITS TO CHECK PRIV ACCESS
	TDNE	TAC1,DAT		;IS ACCESS ALLOWED BY PRIVILEGE?
	JRST	(AC1)			;YES. PRIV. ACCESS TO FILE
	JRST	PROT2			;CHECK NON-OWNER ACCESS
PROT1:	TLZ	DAT,600000		;OWNER CAN READ OR RENAME
PROT2:	TDNN	DAT,AC3
	JRST	(AC1)			;OK
	JRST	EPROT			;LOSE

PROT3:	TLNE	DAT,500000		;WRITE OR RENAME ACCESS TO UFD?
	JRST	PROT4			;YES. THIS IS USUALLY ILLEGAL
	MOVE	AC2,ACCNAM(DDB)		;USE THE NAME INSTEAD OF PPN FOR LEGALITY
	JRST	PROT0			;OTHERWISE, CONSIDER OTHER CLASS OF USERS

PROT4:	JUMPGE	DAT,PROT5		;JUMP UNLESS 400000 ACCESS REQUESTED
	MOVE	TAC1,FILNAM(DDB)	;GET NAME OF THIS UFD
	CAMN	TAC1,PRJPRG(J)		;BELONGS TO US?
	JRST	(AC1)			;YES.  PROTECTION CHANGE IS OK.
PROT5:	MOVE	TAC1,JBTPRV(J)		;WRITE OR RENAME ACCESS TO UFD
	LSH	TAC1,2
	TDNN	TAC1,DAT
	JRST	EPROT
	JUMPL	DAT,(AC1)		;LEGAL FOR PRIV' USER TO CHANGE PROT
	SKIPN	ACCNAM(DDB)		;WRITE IS LEGAL ONLY IF DELETING
	JRST	(AC1)
	JRST	EPROT

;HERE TO CHECK ACCESS TO A UFD
UPROTC:	MOVE	AC2,ACCPPN(DDB)
UPROTK:	SKIPE	AC3,UFDPRO(DDB)
	JRST	PROT0
	JRST	(AC1)			;AVOID WORK IF THIS IS A UFD ACCESS
;SEARCH MFD AND UFD FOR FILE.
;PUT DIRECTORY DATA IN SRCNAM,SRCEXT,SRCPRO,SRCLOC.
;FLAG IS LEFT IN SRCTMP.

; MFD, UFD FORMAT:
;	NAME
;	EXT, DATE CREATED
;	PROT, MODE, TIME LAST WRITTEN
;	LOCATION (LOGICAL BLOCK NO.)

FILSRC:	PUSHJ	P,SRCH
	SKIPE	DAT				;WANT MFD?
	PUSHJ	P,QEWAIT			;NO, READ DIRECTORY
	TLNE	IOS,LOSBIG
	JRST	EGARPJ
	POPJ	P,

UFDSRC:	PUSHJ	P,SRCH
	JUMPN	DAT,CPOPJ			;RETURN
	JRST	EACMFD				;ILLEG MFD OP.

SRCH:	MOVEI	TEM,ACCNAM(DDB)
SRCH1:	MOVE	DAT,MFDLOC
	MOVEM	DAT,SRCLOC(DDB)
	MOVE	TAC,UPPN(TEM)
	MOVSI	TAC1,UFDEXT
	HLLZ	AC3,UEXT(TEM)
	CAME	TAC,SYSPPN			;LOOKING FOR [1,1] FILE?
	JRST	SRCHM				;NO, GO SEARCH MFD FOR UFD
	CAMN	TAC1,AC3			;IT IS [1,1], IS IT UFD?
	CAME	TAC,UNAM(TEM)			;IS UFD, IS IT MFD?
	JRST	SRCHU				;NO, SEARCH MFD FOR IT
	MOVEM	DAT,SRCTMP(DDB)			;YES, PLUG IN MFD STUFF
	MOVE	DAT,MFDEXT
	MOVEM	DAT,SRCEXT(DDB)
	MOVE	DAT,MFDPRO
	MOVEM	DAT,SRCPRO(DDB)
	MOVEM	DAT,UFDPRO(DDB)			;DEFINE ACCESS ALLOWED TO MFD
	MOVEI	DAT,0				;MFD FLAG
	POPJ	P,

SRCHM:	MOVEM	TAC,SRCNAM(DDB)
	MOVEM	TAC1,SRCEXT(DDB)
	CAMN	TAC,CUSPPN			;IS THIS THE BLOODY CUSP?
	SKIPN	TAC1,CUSLOC			;YES, DO WE REMEMBER WHERE IT IS?
	CAIA					;NO TO ONE OF THESE
	JRST	CUSSRC				;YES, GO SEARCH IT
IFN FTDSKPPN,<
	SKIPN	TAC1,DSKPPN(J)
	MOVE	TAC1,PRJPRG(J)
	CAMN	TAC,TAC1			;HIS OWN UFD?
>;FTDSKPPN
IFE FTDSKPPN,<	CAMN	TAC,PRJPRG(J) >
	SKIPN	TAC1,JBTUFD(J)			;DO WE KNOW WHERE IT IS?
	JRST	SRCHM1				;NO. LOOK IN MFD FOR ITS LOC.
CUSSRC:	HRRZM	TAC1,SRCLOC(DDB)		;TRY HERE.
	JRST	SRCHU				;GO GET UFD (BYPASS MFD SEARCH)

SRCHM1:	MOVEI	DAT,DIRSRC			;LOOK IN MFD FOR USER'S UFD
	PUSHJ	P,QEWAIT
	TLNE	IOS,LOSBIG
	JRST	EGARJ2
	SKIPG	SRCTMP(DDB)			;FOUND IT?
	JRST	ENOUFD				;NO, LOSE
	MOVE	TAC,SRCNAM(DDB)			;DID WE JUST LOOK AT GUY'S OWN UFD?
	MOVE	TAC1,SRCLOC(DDB)
IFN FTDSKPPN,<	SKIPN	DAT,DSKPPN(J)
		MOVE	DAT,PRJPRG(J)
		CAMN	TAC,DAT		>;FTDSKPPN
IFE FTDSKPPN,<	CAMN	TAC,PRJPRG(J)	>
	MOVEM	TAC1,JBTUFD(J)
	CAMN	TAC,CUSPPN
	MOVEM	TAC1,CUSLOC
SRCHU:	HLLZ	TAC1,UEXT(TEM)
	MOVEM	TAC1,SRCEXT(DDB)
	MOVE	TAC,UNAM(TEM)			;LOOK IN UFD FOR FILE
	MOVEM	TAC,SRCNAM(DDB)
	MOVEI	DAT,DIRSRC
	POPJ	P,

;INSERT A FILE NAME IN UFD.
;UFD RTVL MUST BE IN DDB.

DIRINS:	MOVEI	DAT,DIRI1			;TRY TO PUT NEW NAME IN
	PUSHJ	P,QEWAIT			;WITHOUT EXTENDING UFD.
	SKIPN	SRCTMP(DDB)			;SUCCESSFUL?
	POPJ	P,				;YES, RETURN
	PUSHJ	P,MAKBLK			;NO ROOM, GET NEW BLOCK
	MOVEI	DAT,DIRI2
	PUSHJ	P,QEWAIT			;WRITE NEW NAME IN IT
	POPJ	P,

;*** INTERRUPT SUBRS ***

DIRI1:	SETZM	SRCNAM(DDB)
	PUSHJ	P,DIRSRC			;LOOK FOR A HOLE.
	SKIPL	SRCTMP(DDB)			;FOUND ONE?
	JRST	DIRIHF				;YES, GO USE IT.
	SKIPN	AC1,DDLNG+SYSRTV		;UFD WD CT
	JRST	DIRI1W				;ZERO LENGTH FILE MUST HAVE ROOM
	IDIVI	AC1,BKDSIZ			;ROOM IN THIS BLOCK?
	CAIG	AC2,BKDSIZ-4
	JUMPN	AC2,DIRI1W			;YES, GO FIX UNLESS INTEGRAL
						;NUMBER OF BLOCKS
	SETOM	SRCTMP(DDB)			;FLAG MORE SPACE NEEDED
	MOVEI	DAT,RCPBLK
	ADDM	DAT,USETP(DDB)
	POPJ	P,				;BACK TO UUO LVL TO GET IT.

DIRIHF:	MOVEI	TAC1,SYSDTA-1(TAC1)
	PUSH	TAC1,ACCNAM(DDB)
	PUSH	TAC1,ACCEXT(DDB)
	PUSH	TAC1,ACCPRO(DDB)
	PUSH	TAC1,FILLOC(DDB)
	SETZM	SRCTMP(DDB)			;FLAG SUCCESSFUL.
	JRST	REWRIT				;SPIT IT BACK OUT

DIRI2:	MOVEI	TAC1,0
DIRI1W:	PUSH	P,TAC1
	MOVEI	DAT,4
	ADDM	DAT,DDLNG(DDB)			; EXTEND UFD
	PUSHJ	P,SPREAD
	MOVE	TAC,[XWD -BKDSIZ,SYSDTA]	;RTVL OUT, JUST WRITE DATA!
	MOVEM	TAC,TFRIOW(DDB)
	MOVE	TAC,USETP(DDB)
	PUSHJ	P,LR2BLK
	JUMPE	TAC,[	POP	P,TAC1		;0 MEANS BAD RETRIEVAL!
			JRST	SETLOS]
	PUSHJ	P,BKMAP				;FINISH MAPPING
	MOVEM	TAC,TFRSEC(DDB)
	POP	P,TAC1
	JRST	DIRIHF

;*** I-SUBR TO READ DIRECTORY INTO SYSBUF & SEARCH.
;RETURNS FLAG IN SRCTMP: -1 IF NOT FOUND
;	0 IF DIFFERS IN EXT AND SPECIFIED EXT WAS 0
;	+N IF EXACT MATCH FOUND

DIRSRC:	MOVE	TAC,SRCLOC(DDB)			;LOCATION OF UFD FILE
	PUSHJ	P,NEWFIL
	SETZM	SRCTMP(DDB)
	PUSHJ	P,GETBLK
	MOVE	TAC,DDPPN+SYSRTV		;BLOCK SHOULD LOOK LIKE UFD.
	HLLZ	TAC1,DDEXT+SYSRTV
	CAMN	TAC,SYSPPN
	CAME	TAC1,MFDEXT
	PUSHJ	P,AUDHAK			;IT DOESN'T.
	MOVE	TAC,MFDLOC
	MOVE	TAC1,SYSRTV+DSATID		;GET SATID OF CURRENT UFD.
	CAMN	TAC,SRCLOC(DDB)			;IS THIS THE MFD ?
	CAMN	TAC1,SATID			;YES. DOES ITS SATID AGREE
						;WITH THE MASTER COPY ?
	JRST	DIRSA
	EXCH	TAC1,SATID			;MAKE IT GOOD, WE HOPE
	PUSHACS
	PUSHJ	P,DISDATE
	PUSHJ	P,DISERR
	[ASCIZ/SATID CLOBBERED!
SATID IN CORE=/]
	DISARG(OCT,<-20+TAC1(P)>)		;SATID IN CORE
	[ASCIZ/
SATID ON DISK=/]
	DISARG(OCT,SATID)
	[ASCIZ/
DON'T CONTINUE UNTIL YOU GET A WIZARD.
/]
	-1
	MOVE	TAC,SATID			;MAKE SURE ALL THE SATID'S AGREE
	MOVEM	TAC,SATID1
	MOVEM	TAC,SATID2
	CONO	PI,PIOFF
	SETOM	DISFLAG				;FORCE TYPEOUT
	PUSHJ	P,DISFLUSH
	POPACS
	CONO	PI,PION
	PUSHJ	P,DDTCALL			;MAKE HIM DO A CPOPJ$G
DIRSA:	MOVE	TAC1,SYSRTV+DQINFO+3		;GET DEFAULT FILE PROTECTION
	HLRM	TAC1,UFDPR1(DDB)		;ICK!
	MOVSI	TAC1,777000
	AND	TAC1,SYSRTV+DDPRO
	MOVEM	TAC1,UFDPRO(DDB)		;SAVE PROTECTION OF THIS UFD
	SETZ	TAC1,
	MOVN	TEM,DDLNG+SYSRTV		;GET -WORD COUNT
	JUMPE	TEM,DIRSN			;EMPTY DIRECTORY
DIRS1:	MOVEI	TAC1,0
DIRS2:	MOVE	DAT,SYSDTA(TAC1)
	CAME	DAT,SRCNAM(DDB)
	JRST	DIRSX				;NOT THIS ONE
	JUMPE	DAT,DIRSRZ			;LOOKING FOR HOLE, FOUND ONE
	MOVE	DAT,SYSDTA+1(TAC1)		;NAME SAME, SAVE STUFF ...
	MOVEM	DAT,SRCTMP(DDB)			;FOR EXT CHECK.
	MOVE	TAC,SYSDTA+2(TAC1)
	MOVEM	TAC,SRCPRO(DDB)
	MOVE	TAC,SYSDTA+3(TAC1)		;FILE LOCN (MUST BE +)
	MOVEM	TAC,SRCLOC(DDB)
	XOR	DAT,SRCEXT(DDB)			;COMPARE EXTENSION
	TLNN	DAT,-1
	JRST	DIRSE				;MATCHES, THIS IS IT.
DIRSX:	ADDI	TEM,4				;INDEXING.
	ADDI	TAC1,4
	JUMPGE	TEM,DIRSF			;OUT OF ENTRIES, RETURN FAIL.
	CAIGE	TAC1,BKDSIZ
	JRST	DIRS2
	MOVEI	TAC1,RCPBLK
	ADDM	TAC1,USETP(DDB)
	PUSHJ	P,GETBLK			;GET NEXT BLOCK OF DIRECTORY FILE
	JRST	DIRS1

DIRSF:	SKIPN	SRCTMP(DDB)			;ANY PARTIAL MATCH?
	JRST	DIRSN				;NO, RETURN FAIL
	SKIPN	SRCEXT(DDB)			;BLANK EXT SPECIFIED?
DIRSRZ:	TDZA	TAC,TAC				;RETURN MAYBE, IF SO.
DIRSN:	SETOM	TAC				;NO, RETURN FAILURE

DIRSE:	EXCH	TAC,SRCTMP(DDB)			;ENDFILE OR ENTRY FOUND
	MOVEM	TAC,SRCEXT(DDB)			;RETURN BEST BET
	POPJ	P,
; RETRIEVAL SUBRS

GETRET:	MOVEI	DAT,GGRETI			;GET RTVL IN IF IT IS NOT
	PUSHJ	P,TSTRET			;IS IT?
	PUSHJ	P,QEWAIT			;NO, GO GET IT
	PUSHJ	P,TSTRET			;IS IT REALLY HERE?
	POPJ	P,				;NO, GIVE ERROR RETURN
	JRST	CPOPJ1				;YES, SUCCESS.

TSTRET:	MOVE	TAC,USETP(DDB)			;SKIP IF RTVL IS IN.
	SKIPN	TAC1,DGRP1R(DDB)
	POPJ	P,				;NOT IN, RETURN
	CAIGE	TAC,RCPGRP(TAC1)
	CAIGE	TAC,(TAC1)
	POPJ	P,				;LOSE, WRONG GROUP IN
	JRST	CPOPJ1				;IN, SKIP

MAKBLK:	PUSHJ	P,GETRET			;GET GROUP RETRIEVAL IN!
	PUSHJ	P,ASNGRP			;NO SUCH GROUP, MAKE ONE
	MOVE	TAC,USETP(DDB)
	PUSHJ	P,LR2BLK			;LOOK UP BLOCK IN RTVL.
	JUMPN	TAC,CPOPJ			;IT EXISTS, RETURN
	PUSHJ	P,ASNBLK			;IT DOESN'T, GET ONE FROM SAT
	TLO	IOS,PNTDIF			;NOTE RTVL NOT OUT!!!
	MOVE	AC1,USETP(DDB)			;MAKE RTVL ENTRY
	SUB	AC1,DGRP1R(DDB)			;PUT ABS BLK PTR IN CORR HALFWD.
	IDIVI	AC1,RCPBLK
	LSHC	AC1,-1
	ADDI	AC1,DPTR(DDB)
	JUMPL	AC2,MAKB3
	HRLM	TAC,(AC1)			;EVEN IN LEFT HALF
	POPJ	P,

MAKB3:	HRRM	TAC,(AC1)			;ODD IN RIGHT HALF
	POPJ	P,

;ASSIGN A BLOCK FOR A NEW GROUP.

ASNGRP:	PUSHJ	P,ASNBLK			;GET BLOCK FROM SAT
ASNGR1:	MOVEM	TAC,DNXTGP(DDB)			;PUT INTO LINK
	MOVEI	DAT,SPREAD			;SMEAR EXISTING RTVL OUT...
	SKIPE	DGRP1R(DDB)			;IF THERE IS A CURRENT GROUP.
	PUSHJ	P,QEWAIT
	SETZM	TAC
	EXCH	TAC,DNXTGP(DDB)			;NEW BLOCK...
	HRLZM	TAC,DPTR(DDB)			;IS FIRST OF NEW GRP.
	SETZM	DPTR+1(DDB)			;CLEAR OUT REST OF RTVL.
	HRLI	TAC1,DPTR+1(DDB)
	HRRI	TAC1,DPTR+2(DDB)
	BLT	TAC1,DDEND-1(DDB)
	MOVE	TAC,USETP(DDB)
	MOVEM	TAC,DGRP1R(DDB)
	TLO	IOS,PNTDIF			;NOTE NEW RTVL NOT OUT.
	POPJ	P,

;SPREAD UPDATED RTVL OVER BLOCKS IN CURRENT GROUP.
;NORMALLY WRITES FROM DDB

SPREDT:	MOVE	AC2,USETP(DDB)			;OUT RTVL UP TO CURR BLOCK.
	SUBI	AC2,RCPBLK
	JRST	SPREDF

SPREAD:	MOVE	AC2,DGRP1R(DDB)			;OUT RTVL OVER WHOLE GROUP
	ADDI	AC2,RCPGRP-RCPBLK

SPREDF:	MOVEI	TAC1,DSKDAT(DDB)
SPREDD:	HRLI	TAC1,-SECSIZ
	SKIPN	TEM,DGRP1R(DDB)
	POPJ	P,				;NO RTVL TO SPREAD.
	MOVEM	TAC1,TFRIOW(DDB)
	MOVEI	TAC1,DWRITE!IOPDCH
	MOVSM	TAC1,TFRCTL(DDB)
SPREDL:	CAMLE	TEM,AC2
	POPJ	P,				;DONE WITH GROUP
SPREDR:	MOVE	TAC,TEM		
	PUSHJ	P,LR2BLK
	JUMPE	TAC,SPREDI			;NON EX BLOCK
	PUSHJ	P,BK2SEC
	MOVEM	TAC,TFRSEC(DDB)
	PUSHJ	P,TSTART
SPREDI:	ADDI	TEM,RCPBLK
	JRST	SPREDL


AUDINF:	MOVSI	TAC1,FILNAM(DDB)
	HRRI	TAC1,DSKDAT(DDB)		;BLT AUDIT INFO INTO RTVL
	BLT	TAC1,DSKDAT+7(DDB)
	MOVE	TAC1,SATID
	MOVEM	TAC1,DSATID(DDB)
	POPJ	P,

AUDCHK:	MOVE	TAC,FILNAM(DDB)
	CAME	TAC,DDNAM(DDB)
	TLO	IOS,LOSBIG
	HLLZ	TAC,FILEXT(DDB)
	HLLZ	TAC1,DDEXT(DDB)
	CAME	TAC,TAC1
	TLO	IOS,LOSBIG
	MOVE	TAC,FILPPN(DDB)
	CAME	TAC,DDPPN(DDB)
AUDHAK:	TLO	IOS,LOSBIG
	TLNE	IOS,LOSBIG
	MOVEM	DDB,ACDDB			;SAVE LOSER FOR DEBUGGING
	POPJ	P,

;SET UP GGRETI TO READ A NEW FILE, WHOSE RTVL ISN'T IN.

NEWFIL:	CAME	TAC,DDLOC(DDB)			;IS RIGHT RTVL IN?
NEWFI1:	SETZM	DGRP1R(DDB)			;NO, FORCE IT TO BE READ
	MOVEM	TAC,DDLOC(DDB)
	MOVEI	TAC1,1
	MOVEM	TAC1,USETP(DDB)
	POPJ	P,

; GET BLOCK CONTAINING USETP INTO SYSBUF. 

GETBLK:	PUSHJ	P,GGRETI			;GET RTVL IN
	JUMPE	TAC,CPOPJ			;NON EX=EOF
	MOVE	TAC,USETP(DDB)
	SKIPN	TFRIOW(DDB)			;DID GGRETI READ?
	JRST	GETBK1				;NO, GO READ BLOCK
	MOVE	TAC1,DGRP1R(DDB)		;FIRST GROUP OF BLOCK
	CAIGE	TAC,RCPBLK(TAC1)		;IS ONE WE WANT IN IN THIS BLOCK?
	POPJ	P,				;YES, RETURN.
GETBK1:	PUSHJ	P,LR2BLK
	JUMPE	TAC,CPOPJ			;NON EX = EOF
	PUSHJ	P,BK2SEC
	MOVEM	TAC,TFRSEC(DDB)			;READ IT INTO SYSBUF
	MOVE	TAC,BUFIOW
	MOVEM	TAC,TFRIOW(DDB)
	MOVEI	TAC,IOPCHN
	MOVSM	TAC,TFRCTL(DDB)
	PUSHJ	P,TSTART
	POPJ	P,

; GET RTVL FOR GROUP INTO DDB IF NOT ALREADY THERE. 

GGRETI:	SETZM	TFRIOW(DDB)			;FLAG FOR GETBLK.
	SKIPN	TAC1,DGRP1R(DDB)		;IF NO RTVL IN,
	JRST	GGBLK1				;GET BLOCK 1.
	MOVE	TAC,USETP(DDB)
	CAIL	TAC,RCPGRP(TAC1)		;USETP IN CURRENT GROUP?
	JRST	GGNXT				;BEYOND, TRY SUCCESSOR
	CAIL	TAC,(TAC1)
	POPJ	P,				;IN THIS ONE.

GGBLK1:	SKIPA	TAC,DDLOC(DDB)			;START AT BEGINNING.
GGNXT:	MOVE	TAC,DNXTGP(DDB)			;GO ON TO NEXT GROUP
	JUMPE	TAC,CPOPJ			;RETURN IF EOF
	PUSHJ	P,BK2SEC
	MOVEM	TAC,TFRSEC(DDB)
	MOVE	TAC,BUFIOW			;READ ENTIRE BLOCK...
	MOVEM	TAC,TFRIOW(DDB)
	MOVEI	TAC,IOPCHN
	MOVSM	TAC,TFRCTL(DDB)
	PUSHJ	P,TSTART			;IN CASE SOMEONE WANTS IT.
	HRLI	TAC,SYSBUF			;GOT CORRECT GRP. BLT RTVL
	HRRI	TAC,DSKDAT(DDB)			;AND AUDIT TO DDB.
	BLT	TAC,DSKDAT+SECSIZ-1(DDB)
	MOVE	TAC,USETP(DDB)
	MOVE	TAC1,DGRP1R+SYSRTV
	CAIL	TAC,RCPGRP(TAC1)		;IN THIS GROUP?
	JRST	GGNXT
	POPJ	P,

;LOGICAL RECORD TO BLOCK. CORRECT GROUP IS ASSUMED.

LR2BLK:	SUB	TAC,DGRP1R(DDB)
	CAIL	TAC,0
	CAIL	TAC,RCPGRP
	MOVEI	TAC,1				;WRONG GROUP.DEFAULT SELECT REC1.
	IDIVI	TAC,RCPBLK
	MOVEI	AC3,1(TAC1)		;PHYSICAL RECORD WITHIN BLOCK (INCL RTRVL)
	LSHC	TAC,-1
	ADDI	TAC,DPTR(DDB)
	MOVE	TAC,(TAC)
	SKIPL	TAC1
	HLRS	TAC
	HRRZS	TAC
	POPJ	P,


;CONVERT BLOCK NO. TO DISK ADDRESS OF FIRST RECORD OF BLOCK
BK2SEC:	SETZ	AC3,
;MAPPING BLOCK NO. AND RECORD NO. TO DISK ADDRESS
BKMAP:	LSH	TAC,6				;TO STOP LATER.
	ANDI	AC3,77				;IGNORE IMPOSSIBLE RECORD NOS.
	IOR	TAC,AC3
	POPJ	P,

↑DSKRES:MOVEI	TAC,LSTBIT-=200			;CALC DSK RESOURCES. FROM TOTAL,
	SUB	TAC,DSKUSE			;LESS THOSE IN USE, YOU HAVE..
	JUMPGE	TAC,CPOPJ
	MOVEI	TAC,0				;WOULD YOU BELIEVE..NONE?
	POPJ	P,
; SAT TABLE OPERATIONS

CUSATO:	SKIPN	SATFLG			;SAT OUT FROM UUO LEVEL, IF CHANGED.
	POPJ	P,			;NO CHANGE, RETURN
	MOVE	TAC,TIME		;GET CURRENT TIME
	MOVEM	TAC,DTIME		;SAVE IN SAT TABLE
	MOVE	TAC,THSDAT
	MOVEM	TAC,DDATE		;AND CURRENT DATE
	MOVEI	DAT,SATOUT
	JRST	NENTER			;QUEUE THIS AND POPJ

SATOUT:	SKIPA	TAC,[DWRITE!IOPCHN]	;WRITE SAT
SATIN:	MOVEI	TAC,IOPCHN		;READ SAT
	TLO	IOS,SATOP
	MOVSM	TAC,TFRCTL(DDB)
	MOVE	TAC,[XWD -SATSIZ,SATTAB]
	MOVEM	TAC,TFRIOW(DDB)		;IOWD FOR THIS TRANSFER
	SETZM	TFRSEC(DDB)
	PUSHJ	P,TSTART
	SETZM	SATFLG
	TLZ	IOS,SATOP
	POPJ	P,

IASNBK:	PUSHJ	P,ASNSAT
IFN 0,<		SKIPG	AC1,BADCNT
		POPJ	P,
		CAILE	AC1,BADMAX
		MOVEI	AC1,BADMAX
		CAME	TAC,BADTRK-1(AC1)	;SKIP IF THIS BLOCK IS BAD
		SOJG	AC1,.-1
		JUMPG	AC1,IASNBK		;JUMP TO REJECT THIS BLOCK
>;IFN 0,
	POPJ	P,

ASNBLK:	PUSHJ	P,IASNBK			;ASSIGN SUITABLE BLOCK
	PUSH	P,TAC
	MOVEM	TAC,TFRSEC(DDB)			;SAVE HERE FOR I SUBR
	MOVEI	DAT,RB4WCK			;READ BEFORE WRITE CHECKER
	PUSHJ	P,QEWAIT
	POP	P,TAC
	SKIPN	TFRIOW(DDB)		;SUCCESS?
	JRST	ASNBLK			;NO, ASSIGN ANOTHER BLOCK
	POPJ	P,

; READ BEFORE WRITE CHECKER ** I SUBR
RB4WCK:	SKIPN	TAC,TFRSEC(DDB)		;GET LOGICAL DISK ADDRESS
	JRST	RB4WLS			;LOSE IF ADDRESS IS 0
	PUSHJ	P,BK2SEC		;CONVERT TO PHYSICAL ADDRESS
	MOVEM	TAC,TFRSEC(DDB)		;AND PUT IT BACK
	MOVE	TAC,[XWD -SECSIZ,QBUF]
	MOVEM	TAC,TFRIOW(DDB)
	MOVEI	TAC,IOPCHN
	MOVSM	TAC,TFRCTL(DDB)		;READ OP
	PUSHJ	P,TSTART
	MOVE	IOS,DEVIOS(DDB)
	TRNE	IOS,IODERR!IODTER	;LOSE ON READ?
	JRST	RB4WER			;YES, USE ANOTHER
	SKIPE	QBUF+DDNAM-DSKDAT	;NULL FILE NAME?
	SKIPN	QBUF+DDPPN-DSKDAT	;OR PPN?
	POPJ	P,			;YES, OK TO WRITE HERE
	MOVE	TAC,SATID		;GET SATID FROM CORE
	CAME	TAC,QBUF+DSATID-DSKDAT	;SAME AS ON DISK?
	POPJ	P,			;NO. INVALID SATID MEANS WE CAN WRITE HERE
RB4WLS:	AOS	DSKOVC			;COUNT OVERWRITE CHECK
RB4WER:	SETZM	TFRIOW(DDB)		;FLAG ILLEGAL BLOCK
	POPJ	P,
;ASNSAT
ASNST1:	PUSHJ	P,EDFULL		;"DISK IS FULL" MESSAGE
					;LET HIM TRY AGAIN, IF HE SAYS CONTINUE
ASNSAT:	MOVE	AC2,LSTBLK		;LAST PLACE WE ASSIGNED BLOCK
	ADDI	AC2,1			;START BEYOND THAT
ASNSL1:	CONO	PI,IOPON		;SEE NO EVIL
ASNSAL:	CAIL	AC2,LSTBIT		;OFF THE END YET?
	MOVEI	AC2,1			;YES. START OVER.
	CAMN	AC2,LSTBLK		;WRAP TO WHERE WE STARTED?
	JRST	ASNST1			;YES. ICK. THERE'S NO DISK LEFT
	MOVE	TAC,AC2			;CONVERT BLOCK NUMBER TO BIT AND WORD #
	IDIVI	TAC,44			;WORD NUMBER IN TAC, BIT NUMBER IN TAC1
	MOVEI	AC1,1			;MAKE A BIT MASK
	ROT	AC1,(TAC1)
	TDNE	AC1,SATBIT(TAC)		;THIS BLOCK IN USE?
	AOJA	AC2,ASNSAL		;YES, KEEP LOOKING
	SETOM	SATFLG			;FLAG SAT TABLE IS BEING CHANGED
	CONO	PI,IOPOFF		;DISABLE DISK INTERRUPTS.
	TDNE	AC1,SATBIT(TAC)		;BLOCK STILL FREE ?
	AOJA	AC2,ASNSL1		;ARGGHH! SOMEBODY GLOMMED IT .
	IORM	AC1,SATBIT(TAC)		;MARK IN USE
	XORM	AC1,SATCHK		;UPDATE CHECKSUM.
	CONO	PI,IOPON		;LET THEM BACK IN
	MOVEM	AC2,LSTBLK		;REMEMBER THE LAST BLOCK THAT WAS USED
	AOS	TAC,AC2			;RETURN EXCESS 1 IN TAC.  (AVOID 0)
	AOS	DSKUSE			;COUNT ANOTHER BLOCK IN USE
	POPJ	P,


RTNBLK:	CAIG	TAC,LSTBIT		;SKIP IF INVALID BLOCK.
	SOJGE	TAC,.+2			;REMOVE EXCESS 1 AND JUMP IF VALID
	POPJ	P,			;INVALID BLOCK
	IDIVI	TAC,44
	MOVEI	AC1,1
	ROT	AC1,(TAC1)
	TDNN	AC1,SATBIT(TAC)
	POPJ	P,			;ALREADY OFF!
	ANDCAM	AC1,SATBIT(TAC)
	XORM	AC1,SATCHK		;UPDATE CHECKSUM.
	SOS	DSKUSE			;DECREASE COUNT
	SETOM	SATFLG			;FLAG SAT TABLE NEEDS OUTPUT
	POPJ	P,

↓MRKBLK:CAIG	TAC,LSTBIT
	SOJGE	TAC,.+2
	POPJ	P,
	IDIVI	TAC,44
	MOVEI	AC1,1
	ROT	AC1,(TAC1)
	TDNE	AC1,SATBIT(TAC)
	POPJ	P,
	IORM	AC1,SATBIT(TAC)
	XORM	AC1,SATCHK
	AOS	DSKUSE
	SETOM	SATFLG
	POPJ	P,
;DELETE A FILE, FREE DISK BLOCKS

DELETE:	PUSHJ	P,NEWFIL		;SET UP RTVL FETCH
	MOVEI	DAT,DELFIL
	MOVE	AC1,FILLNG(DDB)
	CAILE	AC1,=50*2000
	JRST	NEWAIT			;MARK ALL BLOCKS EMPTY, CLEAR RTVL
	JRST	QEWAIT

;*** INTERRUPT SUBR ***

DELFIL:	PUSHJ	P,DELBLK
	TRZE	IOS,IODTER		;WAS THERE AN ERROR ?
	JRST	DSIOS
	MOVE	TAC,USETP(DDB)
DELF2:	PUSHJ	P,LR2BLK		;RETURN BLOCKS TO SAT
	JUMPE	TAC,.+2			;NO SUCH BLOCK
	PUSHJ	P,RTNBLK
	MOVEI	TAC,RCPBLK
	ADDB	TAC,USETP(DDB)
	MOVE	TAC1,DGRP1R(DDB)
	CAIGE	TAC,RCPGRP(TAC1)	;HAVE WE GOT TO NXT GRP?
	JRST	DELF2			;STILL IN THIS ONE, CONTINUE
DELF3:	SKIPE	DNXTGP(DDB)		;IS THERE A NEXT GROUP?
	JRST	DELFIL			;YES, DO IT
	POPJ	P,

DELBLK:	PUSHJ	P,GGRETI		;GET INTO CORE
	PUSHJ	P,AUDCHK
	TLZE	IOS,LOSBIG
	JRST	DELBK1
	LDB	AC2,PJOBN		;GET JOB # OF LOSER DELETING FILE
	MOVE	AC1,JOBNAM(AC2)		;NOW REMEMBER SOMETHING ABOUT HIM
	MOVEM	AC1,DQINFO+2(DDB)
	MOVE	AC1,PRJPRG(AC2)
	MOVEM	AC1,DQINFO+3(DDB)
	SETZM	DSATID(DDB)		;JUST CLEAR SATID TO FREE THIS BLOCK
	JRST	SPREAD			;AND POOT IT BACK OUT

DELBK1:	TRO	IOS,IODTER
	JRST	DSIOS
; SWAPPER INTERFACE

;	EXTERNAL SERACT,JOBDAC,MJOBCK,FINISH,JBTCHK,SERA
;	INTERNAL DFWRT,DFRED

;ENTER HERE FROM SWAPPER TO START SWAP (DISK IDLE.)
;TAC=DISK ADDR=SERA; TAC1=IOWD=SQREQ.

↑DFWRT:
↑DFRED:	CONO	PI,IOPOFF		;JUST FOR SAFETY.
	PUSHJ	P,DSSTRT
	MOVSI	17,UUOACS		;RETURN HERE AFTER STARTING XFER
	BLT	17,17			;RELOAD CH7 AC'S (ESP. P)
	CONO	PI,IOPON		;SAFE NOW
	POPJ	P,			;GO TO SWPXIT

DSSTRT:	POP	P,INTRTN
	JSR	DSKSV			;SET UP CH6 PDL.
	PUSHJ	P,SQGOX1		;RETURNS HERE WHEN XFER DONE
	JRST	DNSTR1			;GO DO NEXT I-SUBR.

;ENTER HERE FROM DISK QUEUE SERVICE AFTER FINISHING I-SUBR.

SQGOA:	MOVEI	TAC1,TRIES
	MOVEM	TAC1,SERACT
	MOVSI	TAC,200000		;PUT IN A BIT...
	ORB	TAC,SERA		;TO INDICATE SWAP OP.
	MOVE	TAC1,SQREQ
	MOVM	J,FINISH
	HRRO	J,J			;NEG TO INDICATE SWAPPER
	PUSHJ	P,SQGOX			;DO SWAP OP.
	JRST	DNSTR1			;GO DO NEXT I-SUBR.

;SET UP SWAP OPERATION AND EXECUTE IT.
;ENTER WITH TAC=DISK ADDR=SERA; +1B0 IF INCOMING.
;TAC1=IOWD=SQREQ.

SQGOX1:	ADDI	TAC1,1			;CONVERT IOWD TO 167 FORMAT
SQGOX:	MOVE	DDB,SWPDDB		;GET THE RIGHT DDB
	MOVEM	TAC1,TFRIOW(DDB)
	MOVEI	DAT,IOPCHN
	SKIPL	SERA
	TRO	DAT,DWRITE
	MOVSM	DAT,TFRCTL(DDB)
	PUSHJ	P,SBK2SC		;SPECIAL BLOCK TO SECTOR
	MOVEM	TAC,TFRSEC(DDB)
SQGO2:	SETZB	IOS,DEVIOS(DDB)		;MAKE SURE THERE ARE NO ERROR BITS ON!
	PUSHJ	P,SETACT
	PUSHJ	P,TGO			;ZORCH
	MOVEI	IOS,IOACT
	ANDCAB	IOS,DEVIOS(DDB)
	TRNE	IOS,IOIMPM		;IMMEDIATE ERROR?
	JRST	SWPLUZ
	TRNE	IOS,IODERR!IODTER
	JRST	SWPERR
	JRST	SNOERR			;NO ERRORS

SWPLUZ:	PUSHACS
	PUSHJ	P,DISMES
	ASCIZ	/SWAPPING PACK OFF LINE OR IN WRITE LOCK!
PLEASE FIX IT AND CONTINUE.
/
	SETOM	DISFLAG
	PUSHJ	P,DISFLUSH
	POPACS
	HALT	SQGO2

SWPERR:	SOSLE	SERACT			;COUNT DOWN
	JRST	SQGO2			;TRY AGAIN
	TRO	IOS,IODERR		;TRIED ENOUGH, DIE

SNOERR:	MOVE	TAC,IOS
	ANDI	TAC,IODERR!IODTER	;GET ERROR BITS, IF ANY.
	MOVEM	TAC,SERA		;GIVE TO SWAPPER.
	SETZM	SQREQ
	SETZM	SWPCNT			;WAKE UP SWAPPER.
	POPJ	P,

;MORE MISC: CONVERT SWPSER BLOCK ADDRESS TO DISC ADDRESS.
;COURTESY J. SAUTER

SBK2SC:	HRRZ	TAC,TAC
	IDIVI	TAC,1140		;↑D1216/2
	LSH	TAC,14			;MAKE BAND NO.
	TLO	TAC,400000		;INDICATE SWAP OP
	POPJ	P,
;ENTER HERE FOR HIGH PRIORITY TRANSFER (CURRENTLY ONLY UDP IO).
UEWAIT:	TDZE	IOS,[XWD DEVSBB,IOACT]
	PUSHJ	P,WSYNC
	MOVSI	AC1,DEVIBF
	ANDCAM	AC1,DEVCMR(DDB)
	PUSHJ	P,SETACT
	SKIPN	UPTR			;THIS HAD BETTER BE 0
	JRST	UE2			;OK
	PUSHACS
	PUSHJ	P,DISDATE
	PUSHJ	P,DISERR
	[ASCIZ/UPTR NON-ZERO AT UEWAIT!
UPTR = /]
	DISARG	OCT,UPTR
	[ASCIZ/

/]
	-1
	SETZM	UPTR
	SOS	DQCNT
UE2:	CONO	PI,IOPOFF		;ENTERING CRITICAL SECTION
	MOVEM	DAT,UPTR
	AOS	DQCNT			;COUNT SOMEONE NEW INTO DISK QUEUE
	HRLM	DDB,UPTR
	PUSHJ	P,UE1			;MERGE WITH Q-ENTER CODE
	JRST	WSYNC			;AND WAIT FOR FINISH

;ENTER I-SUBR CALL IN QUEUE FROM UUO LEVEL.

QEWAIT:	PUSHJ	P,QENTER		;PUT REQUEST IN QUEUE
	JRST	WSYNC			;WAIT FOR IT TO FINISH

QENTER:	TDZE	IOS,[XWD DEVSBB,IOACT]
	PUSHJ	P,WSYNC			;JUST IN CASE SOMEBODY GOOFED.
	MOVSI	AC1,DEVIBF
	ANDCAM	AC1,DEVCMR(DDB)
	PUSHJ	P,SETACT		;STORES IOS
QE1:	SKIPE	@MIPTR
	JRST	.-1			;CRASH IF QUEUE FULL
	CONO	PI,IOPOFF		;INTS OFF UNTIL IACTIV:
	HRLM	DDB,@MIPTR		;DDB ADDR...
	HRRM	DAT,@MIPTR		;AND SUBROUTINE ADDR.
	AOS	DAT,MIPTR		;BUMP QUEUE POINTER
	AOS	DQCNT			;ANOTHER LOSER INTO QUEUE
	MOVE	AC1,-1(P)		;MAKE LOG ENTRY
	HRL	AC1,DDB
	MOVEM	AC1,LBEGIN-QBEGIN-1(DAT)
	CAIL	DAT,QEND
	MOVEI	DAT,QBEGIN
	MOVEM	DAT,MIPTR
	SETZM	LBEGIN-QBEGIN(DAT)
UE1:	MOVNI	DAT,1
	EXCH	DAT,DFBUSY
	JUMPN	DAT,IACTIV		;RETURN IF INT PGM RUNNING.
	PUSHJ	P,DIGO			;SAVE UUO AC'S, START I-LEVEL
INSRTN:	MOVSI	17,UUOACS		;RELOAD UUO AC'S FROM INT. SAVE.
	BLT	17,17			;CH6 INTS INHIBITED UNTIL THIS DONE.
IACTIV:	CONO	PI,IOPON
	POPJ	P,			;RETURN TO UUO CALLER.


NEWAIT:	PUSHJ	P,NENTER
	JRST	WSYNC

NENTER:	TDZE	IOS,[XWD DEVSBB,IOACT]
	PUSHJ	P,WSYNC
	MOVSI	AC1,DEVIBF
	ORM	AC1,DEVCMR(DDB)
	TLO	IOS,DEVSBB
	MOVEM	IOS,DEVIOS(DDB)
	JRST	QE1

					;RETURN HERE FROM TSTART WITH I-AC'S SAVED.
DIGO:	POP	P,INTRTN		;ARRANGE I-LEVEL DISMISS
	JSR	DSKSV			;SAVE UUO AC'S IN CH6 AREA.  MUST NOT HAVE
					;CH6 INTERRUPT UNTIL THESE ARE RESTORED.
					;SET UP I-LEVEL PDL (OTHER AC'S NOT NEEDED)
	JRST	DNSTRT			;GO CALL SUBR
;I-LEVEL SUBRS RETURN HERE WHEN DONE TO START ANOTHER REQUEST.


DNXTRQ:	SETZM	@MOPTR			;WIPE OUT RQ JUST FINISHED
	AOS	TAC,MOPTR		;ADVANCE POINTER
	SOS	DQCNT			;ONE LESS LOSER IN QUEUE
	CAIL	TAC,QEND
	MOVEI	TAC,QBEGIN
	MOVEM	TAC,MOPTR

DNSTRT:	SKIPN	TAC,UPTR		;ANY UDP REQUEST?
	JRST	DNSTRU			;NO, CHECK SWAPPER
	PUSHJ	P,DSETUP		;CALL COMMON SETUP AND DISPATCH
	SETZM	UPTR			;CLEAR REQUEST CELL
	SOS	DQCNT
DNSTRU:	SKIPE	SQREQ			;IF SWAPPER WANTS SOMETHING,
	JRST	SQGOA			;GO SEE ABOUT IT.
DNSTR1:	SKIPN	TAC,@MOPTR		;GET NEXT REQUEST.
	JRST	DFSTOP			;NONE PENDING, FLAG IDLE
	PUSHJ	P,DSETUP		;COMMON SETUP AND DISPATCH
ISRTN:	JRST	DNXTRQ

DSETUP:	HLRZ	DDB,TAC
	SETZB	PROG,BKIN		;FLAG SYSBUF EMPTY
	MOVE	IOS,DEVIOS(DDB)
	LDB	J,PJOBN
	MOVSI	AC1,DEVIBF
	TDNE	AC1,DEVCMR(DDB)
	JRST	DNSTR2
	TLZE	IOS,DEVSBB
	PUSHJ	P,MESS2
	SKIPE	J
	SKIPE	PROG,JBTADR(J)
	TRON	IOS,IOACT
	PUSHJ	P,MESS3
	JRST	DNSTR3

DNSTR2:	TRZE	IOS,IOACT
	PUSHJ	P,MESS4
	TLON	IOS,DEVSBB
	PUSHJ	P,MESS5
DNSTR3:	PUSHJ	P,(TAC)			;CALL SUBR
DRQDN:	MOVSI	AC1,DEVIBF
	ANDCAM	AC1,DEVCMR(DDB)
	TDZN	IOS,[XWD DEVSBB,IOACT]	;MOST SUBRS POPJ, THEN
	PUSHJ	P,MESS1			;IOACT OFF AT....
	TLZE	IOS,IOW			;DO THIS RITUAL TO...
	PUSHJ	P,SETIOD		;GET OUT OF IO WAIT
	JRST	DSIOS			;STORE IOS!

DFSTOP:	SETZM	DFBUSY
	JRST	@INTRTN			;RESTORE USER AC'S, DISMISS

MESS1:	PUSHACS
	PUSHJ	P,DISDATE
	PUSHJ	P,DISMES
	ASCIZ/IOACT OFF AT DRQDN.
/
	POPACS
	JRST	DSIOS

MESS2:	PUSHACS
	PUSHJ	P,DISDATE
	PUSHJ	P,DISMES
	ASCIZ/DEVIBF OFF BUT DEVSBB ON AT DNSTRT.
/
	POPACS
	JRST	DSIOS

MESS3:	PUSHACS
	PUSHJ	P,DISDATE
	PUSHJ	P,DISMES
	ASCIZ/IOACT OFF AT DNSTRT.
/
	POPACS
	JRST	DSIOS

MESS4:	PUSHACS
	PUSHJ	P,DISDATE
	PUSHJ	P,DISMES
	ASCIZ/DEVIBF AND IOACT ON AT DNSTRT.
/
	POPACS
	JRST	DSIOS

MESS5:	PUSHACS
	PUSHJ	P,DISDATE
	PUSHJ	P,DISMES
	ASCIZ/DEVIBF ON BUT DEVSSB OFF.
/
	POPACS
	JRST	DSIOS
;I-LEVEL SUBRS PUSHJ HERE TO START A TRANSFER.

TSTART:	MOVEI	TAC,TRIES
	HRRM	TAC,TFRCTL(DDB)
TREDO:	PUSHJ	P,TGO
TFSRTN:	TRNN	IOS,IODERR!IODTER	;ANY ERRORS?
	POPJ	P,			;NO, OK RETURN.
	SOS	TAC,TFRCTL(DDB)		;COUNT DOWN
	TRNE	TAC,-1			;TRIED ENOUGH?
	JRST	TREDO			;NO, TRY AGAIN.
	TLO	IOS,LOSBIG		;INFORM THE HIGHER-UPS.
	POPJ	P,			;RETURN LOSSAGE.

TGO:	MOVEM	DDB,DXB
	MOVEM	J,DXJ
	MOVEM	P,DXP
	TRZ	IOS,IODERR!IODTER	;WE HAVEN'T LOST YET.
	MOVE	TAC,TFRSEC(DDB)
	MOVEM	TAC,DXS
	MOVE	TAC,TFRIOW(DDB)
	MOVEM	TAC,DXW
	HLRZ	TAC,TFRCTL(DDB)
	MOVEM	TAC,DXC
	JRST	GO2314
	SUBTTL ERROR HANDLING

;ERRORS, CLASS 1. ENTER, ETC. RETURN CODES IN E+1

ENOUFD:	POP	P,TAC			;ADJUST STACK
	POP	P,TAC
	JRST	ENOUF1

ENOFIL:	JSP	TAC,ERRC1		;0 - ZERO FILE NAME
ENOUF1:	JSP	TAC,ERRC1		;1 - NO UFD
EPROT:	JSP	TAC,ERRC1		;2 - PROTECT VIOLATION
EFWRIT:	JSP	TAC,ERRC1		;3 - FILE BEING WRITTEN
EDNAME:	JSP	TAC,ERRC1		;4 - NAME IN USE
EXFIL:	JSP	TAC,ERRC1		;5 - NO LOOKUP OR ENTER - RENAME
EANAME:	JSP	TAC,ERRC1		;6 - ENTER (ALTER) NAME DISAGREES
ENODEV:	JSP	TAC,ERRC1		;7 - NO DEVICE (NO INIT)
EGARB1:	JSP	TAC,ERRC2		;10 - GARBAGED UFD (POINTER OUT OF RANGE)
EGARB2: JSP	TAC,ERRC2		;11 - GARBAGED FILE (POINTER WRONG)
EFULLZ:	JSP	TAC,ERRC1		;12 - DISK IS FULL, TRY AGAIN LATER

ERRC2:	TRNN	IOS,GARBIT		;SUPPRESS "BAD RTVL" MESSAGE??
	JRST	EGARB			;NO. NOT A SPECIAL PERSON.
	PUSHJ	P,ERZIOS		;HOLD ALL FURTHER I/O.
ERRC1:	SUBI	TAC,ENOFIL+1		;GET ERROR CODE
	XCTR	XRW,[HRRM TAC,ERRBOX(UUO)]	;STUFF ERROR CODE
	ANDI	TAC,-1
	CAIE	TAC,11			;ALLOW RENAME OF FILE WITH BAD RETRIEVAL
	SETZM	FILNAM(DDB)		;DISABLE RENAME.
	JRST	ERZIOS			;DISABLE I/O. DOES NOT RETURN.

;ERRORS, CLASS 2. FLUSH USER, GO TO SYSTEM.

ENTFUL:	PUSHJ	P,EFULLZ		;GIVE FUNNY ERROR CODE
	TRNE	IOS,GARBIT		;IS HE ENABLED FOR DIRECT RETURN?
	POPJ	P,			;YES. DO IT
EDFULL:	PUSH	P,IOS			;SAVE THE RELEVANT ACS
	PUSHJ	P,DPOPJ			;CLEAR GOBIT IF SET AND SAVE ITS STATE
	PUSH	P,DDB
	PUSHJ	P,TTYFUW		;FIND TTY
	PUSHJ	P,INLMES
ASCIZ /
DISK IS FULL!/
	PUSHJ	P,PRCRCC		;TYPE CRLF ↑C
	PUSHJ	P,TTYSTC		;SET TTY INTO COMMAND MODE.
	PUSHJ	P,STOP1			;STOP THE JOB
	POP	P,DDB
	POP	P,IOS			; RESTORE THE ACCUMULATORS
	POPJ	P,			; AND RETURN TO SENDER.

ENOENT:	JSP	TAC,ERRPTU
	ASCIZ	/NEED ENTER BEFORE OUTPUT/
	JRST	EXCALP

ENOLUK:	JSP	TAC,ERRPTU
	ASCIZ	/NEED LOOKUP BEFORE INPUT/
	JRST	EXCALP

ELOSE:	JSP	TAC,ERRPTU
	ASCIZ	/ERROR IN DSKSER/
	JRST	EXCALP

EGARJ2:	POP	P,TAC
EGARPJ:	POP	P,TAC			;FIX UP STACK
EGARB:	PUSHJ	P,ERZIOS		;HOLD ALL I/O.
	TRNE	IOS,IODTER!IODERR	;MACHINE OR DATA ERRORS?
	JRST	EGARC			;2314 SCREW-UP
	JSP	TAC,ERRPTU
	ASCIZ	/BAD RETRIEVAL/
	JRST	EXCALP

EGARC:	JSP	TAC,ERRPTU
	ASCIZ	/DISK TRANSMISSION ERROR/
	JRST	EXCALP

EACMFD:	JSP	TAC,ERRPTU
	ASCIZ	/CAN'T ENTER-RENAME MFD/
	JRST	EXCALP

EDMPLS:	JSP	TAC,ERRPTU
	ASCIZ	/ILLEGAL FORMAT DUMP MODE COMMAND LIST/
	JRST	EXCALP

ERZIOS:	TLZ	IOS,GOBIT!LOSBIG!READB!WRITEB!ALTERB
	JRST	DPOPJ			;TUCK IOS AWAY. DON'T LET USER DO ANYTHING.
; USER DISK PACK SERVICE

;FIRST THE DISPATCH TABLE (MOSTLY NO-NO'S)

	JRST	UDPINI
	JRST	DHUNG
↑UDPDSP:JRST	ERZIOS	;RELEASE, DISABLE WRITE
	JRST	ERZIOS	;CLOSE OUTPUT, SAME
	JRST	UUOERR	;BUFFERED OUTPUT
	JRST	UUOERR	;BUFFERED INPUT
	JRST	PASSIT	;ENTER, CHECK PASS WORD
	JRST	UUOERR	;LOOKUP
	JRST	UDPOUT	;DUMP OUTPUT
	JRST	UDPIN	;DUMP INPUT
	JRST	UUOERR	;USETO
	JRST	UUOERR	;USETI
	JRST	UUOERR	;UGETF
	JRST	PASSET	;RENAME, SET PASS WORD
	POPJ	P,	;CLOSE INPUT
	POPJ	P,	;UTPCLR
	JRST	UUOERR	;MTAPE

UDPINI:
FOR @$ UNUM←0,UPACKS-1
<	SETZM	UDP$UNUM$DD+DEVIOS	;INITIALIZE UDP IOS'S
>
	POPJ	P,

UDPIN:	MOVEI	TAC1,IOPCHN
	JRST	UDPSER

UDPOUT:	TLNN	IOS,WRITEB		;ENTER DONE?
	JRST	ENOENT			;NO
	MOVEI	TAC1,DWRITE!IOPCHN

UDPSER:	MOVSM	TAC1,TFRCTL(DDB)
	HRRZ	AC1,UUO			;CHECK EVERY ADDRESS IN SIGHT.
	PUSHJ	P,UADCK1		;FOR LEGAL ADDRESS RANGE.
	ADDI	AC1,1
	PUSHJ	P,UADCK1		;CHECK LAST CL WORD TOO.
	XCTR	XR,[SKIPL (UUO)]	;THIS IS BECAUSE DMPCMD DOES BRANCHING!
	JRST	ADRERR			;ONLY IOWD'S ALLOWED
	PUSHJ	P,DMPCMD		;CHECK FOR LEGAL IOWD
	MOVEM	TAC1,CORFAD(DDB)
	XCTR	XR,[MOVE TAC1,(UUO)]	;GET IOWD
	LDB	DAT,PSEGN		;UPPER (IF ANY)
	JUMPE	DAT,UDPS1		;NONE, MUST BE IN LOWER
	HRRZ	DAT,JBTADR(DAT)		;RELOC OF UPPER
	TRZN	TAC1,400000		;IN UPPER?
UDPS1:	HRRZ	DAT,PROG		;AFTER ALL THAT ITS IN THE LOWER
	ADDI	TAC1,1(DAT)		;RELOCATE AND MAKE IT XWD -WC,ADDRESS
	MOVEM	TAC1,TFRIOW(DDB)	;GOD ONLY KNOWS WHAT MCGUIRE WILL DO WITH THIS
	XCTR	XR,[HRRZ TAC1,1(UUO)]	;GET UDP BLOCK ADDR.
	LDB	DAT,PUNIT
	LDB	DAT,[POINT 32,NCYLSH+FPACKS(DAT),31]	;NUMBER OF CYLS ON THIS PACK
	IMULI	DAT,BKPTRK*TRKCYL	;MULTIPLY TO GET TOTAL NUMBER OF BLOCKS
	CAIL	TAC1,(DAT)		;TOO BIG?
	JRST	UADRER			;NO GOOD.
	MOVE	TAC,JBTPRV(J)
	TLNN	TAC,UDPPRV		;LET DUMPER(1,2) GET AT LAST BLOCK
	CAIE	TAC1,-1(DAT)		;LAST LOGICAL BLOCK
	CAIA
	JRST	UADRER
	ADD	TAC1,UDPOFF(DDB)	;KLUGE UP START ADDR OF UDP.
	LSH	TAC1,6			;PRETEND RECORD ZERO.
	XCTR	XR,[HLRZ TAC,1(UUO)]
	CAILE	TAC,RCPBLK		;LEGAL RECORD NUMBER?
	JRST	UADRER
	IOR	TAC1,TAC		;OR IT IN
	MOVEM	TAC1,TFRSEC(DDB)
	PUSHJ	P,GOSET
	SETOM	DDLOC(DDB)
	MOVEI	DAT,TSTART
	PUSHJ	P,UEWAIT
	SETZM	DDLOC(DDB)
	JRST	DPOPJ
;UDP PASS WORD STUFF

PASSIT:	MOVE	TAC,JBTPRV(J)
	TLNE	TAC,UDPPRV		;LET DUMPER THROUGH (1,2)
	JRST	PASSI1
	TLZ	IOS,WRITEB		;LOSE FOR NOW
	MOVEI	DAT,PASSIN		;READ PASSWORD BLOCK
	PUSHJ	P,NEWAIT
	TRNE	IOS,IODERR!IODTER	;ERRORS?
	JRST	EGARB1			;YES
	MOVE	TAC,['PASS  ']		;CHECK FOR INITIALIZATION
	CAMN	TAC,DSKDAT(DDB)
	CAME	TAC,DSKDAT+1(DDB)
	JRST	PASSI1			;NOT INITIALIZED, LET HIM IN
	XCTR	XR,[MOVE TAC,(UUO)]	;GET PASS WORD FROM USER
	SKIPE	DSKDAT+2(DDB)		;MAY NOT BE NECESSARY
	CAMN	TAC,DSKDAT+2(DDB)	;SAME PASS WORD?
	CAIA				;YES
	JRST	EPROT			;PROTECTION FAILURE
PASSI1:	TLO	IOS,WRITEB		;ALLOW WRITE ACCESS
	AOS	(P)			;SUCCESS
	JRST	DPOPJ

PASSET:	MOVE	TAC,JBTPRV(J)
	TLNE	TAC,UDPPRV		;LET DUMPER IN ALWAYS(1,2)
	JRST	PASSE1
	TLZN	IOS,WRITEB		;CAN HE DO THIS?
	JRST	ENOENT			;NO
PASSE1:	MOVE	TAC,['PASS  ']
	MOVEM	TAC,DSKDAT(DDB)
	MOVEM	TAC,DSKDAT+1(DDB)
	XCTR	XR,[MOVE TAC,(UUO)]	;GET NEW PASS WORD!
	MOVEM	TAC,DSKDAT+2(DDB)
	SETZM	DSKDAT+3(DDB)
	HRRI	TAC,DSKDAT+3(DDB)
	HRL	TAC,TAC
	ADDI	TAC,1
	BLT	TAC,DSKDAT+SECSIZ-1(DDB)	;CLEAR THE REST
	MOVEI	DAT,PASOUT			;WRITE IN PASS WORD BLOCK
	PUSHJ	P,NEWAIT
	TRNE	IOS,IODERR!IODTER		;ERRORS?
	JRST	EGARB1
	JRST	PASSI1				;OK

;****** I-LEVEL SUBR ******
PASOUT:	SKIPA	TAC,[DWRITE!IOPCHN]		;WRITE
PASSIN:	MOVEI	TAC,IOPCHN			;READ
	MOVSM	TAC,TFRCTL(DDB)
	MOVE	TAC,[XWD -SECSIZ,DSKDAT]
	ADDI	TAC,(DDB)
	MOVEM	TAC,TFRIOW(DDB)
	LDB	TAC,PUNIT
	LDB	TAC,[POINT 32,NCYLSH+FPACKS(TAC),31]
	IMULI	TAC,BKPTRK*TRKCYL
	SUBI	TAC,1
	ADD	TAC,UDPOFF(DDB)			;ADD BASE ADDRESS
	LSH	TAC,6				;RECORD 0
	MOVEM	TAC,TFRSEC(DDB)
	JRST	TSTART				;DO IT